Commit b719f735 authored by Bechir Zalila's avatar Bechir Zalila
Browse files

* New Backend to support fault tolerence in Ocarina. Using the EMv2

	annex and a new property set, this backend expands AADL models having
	replication properties into classic AADL models that can be handled
	with code generators.

	(Phd thesis work of Wafa Gabsi)
parent c935cfe6
property set Replication_Properties is
-- description of the context, requirements and goal of the replication
Description : aadlstring applies to (system, process, thread, processor, device);
-- Specification of the replica number
Replica_Number : aadlinteger applies to ( system, process, thread, processor, device);
-- Min_Nbr_Replica: A constant that represents the minimal number of replica.
Min_Nbr_Replica : constant aadlinteger => 3 ;
-- Max_Nbr_Replica: A constant that represents the maximal number of replica.
Max_Nbr_Replica : constant aadlinteger => 7 ;
-- Identifiers of the different generated replica
Replica_Identifiers : list of aadlstring applies to (system, process, thread, processor, device);
--Replication type
-- Passive Replication: one replica has two behaviors (primary and backup behaviors)
-- Active Replication: all replica have the same behavior and there is a consensus algorithm to vote between them
Replication_Types: type enumeration (ACTIVE , PASSIVE);
Replica_Type : Replication_Properties::Replication_Types applies to (system, process, thread, processor, device);
-- the consensus algorithm source text
Consensus_Algorithm_Source_Text: aadlString applies to (port, data access, system, processor, device);
-- to refer to a subprogram or thread classifier
Consensus_Algorithm_Class : classifier (subprogram) applies to (port, data access, system, processor, device);
-- to refera subprogram or a thread instance
Consensus_Algorithm_Ref : reference (subprogram) applies to (port, data access, system, processor, device);
end Replication_Properties;
......@@ -28,6 +28,7 @@ AADL_V2_PROPERTIES = $(srcdir)/AADLv2/aadl_project.aadl \
$(srcdir)/AADLv2/pok_properties.aadl \
$(srcdir)/AADLv2/programming_properties.aadl \
$(srcdir)/AADLv2/base_types.aadl \
$(srcdir)/AADLv2/replication_properties.aadl \
$(srcdir)/AADLv2/errorlibrary.aadl \
$(srcdir)/AADLv2/taste_properties.aadl \
$(srcdir)/AADLv2/transformations.aadl
......
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- OCARINA.BACKENDS.REPLICATION_EXPANDER --
-- --
-- B o d y --
-- --
-- Copyright (C) 2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- Ocarina is maintained by the TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Ocarina.Namet;
with Utils;
with Ocarina.Output;
with Outfiles;
with Locations; use Locations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ocarina.ME_AADL;
with Ocarina.BE_AADL;
with Ocarina.AADL_Values;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Entities;
with Ocarina.ME_AADL.AADL_Tree.Nutils;
with Ocarina.Backends.Messages;
with Ocarina.Analyzer.AADL.Finder;
with Ocarina.Me_AADL.AADL_Tree.Entities.Properties;
with Ocarina.Builder.AADL.Components.Subcomponents;
with Ocarina.Builder.AADL.Components.Connections;
with Ocarina.Builder.AADL.Components.Features;
with Ocarina.Builder.AADL.Components;
with Ocarina.Builder.AADL.Components.Subprogram_Calls;
with Ocarina.Builder.AADL.Properties;
package body Ocarina.Backends.Replication_Expander is
use Ocarina.Namet;
use Utils;
use Ocarina.Output;
use Outfiles;
use Ocarina.ME_AADL;
use Ocarina.BE_AADL;
use Ocarina.AADL_Values;
use Ocarina.ME_AADL.AADL_Tree.Nodes;
use Ocarina.ME_AADL.AADL_Tree.Nutils;
use Ocarina.Backends.Messages;
use Ocarina.ME_AADL.AADL_Tree.Entities;
use Ocarina.Analyzer.AADL.Finder;
use Ocarina.Me_AADL.AADL_Tree.Entities.Properties;
use Ocarina.Builder.AADL.Components.Subcomponents;
use Ocarina.Builder.AADL.Components;
use Ocarina.Builder.AADL.Properties;
use Ocarina.Builder.AADL.Components.Connections;
use Ocarina.Builder.AADL.Components.Features;
use Ocarina.Builder.AADL.Components.Subprogram_Calls;
package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
package ATNU renames Ocarina.ME_AADL.AADL_Tree.Nutils;
--------------
-- Generate --
--------------
procedure Generate (AADL_Root : Types.Node_Id) is
begin
Write_Line ("--------------------------------------------------");
Write_Line ("------------ FT-Replication Generator ------------");
Write_Line ("--------------------------------------------------");
Write_Line (" ");
Expand_With_Replicas (AADL_Root);
end Generate;
----------
-- Init --
----------
procedure Init is
begin
Register_Backend ("ft_replication", Generate'Access, FT_Replication);
end Init;
function Is_Node_Of_Node_List (Node : Node_Id; List : Node_List)
return boolean;
procedure Remove_Node_From_Node_List (Node : in out Node_Id;
List : in out Node_List);
function Has_Replication_Properties (N : Node_Id) return boolean;
function Is_Defined_Import_Declaration (N : Node_Id)
return boolean;
procedure Thread_Replication (T : Replication_Info);
procedure Process_Replication (P : Replication_Info);
procedure System_Replication (S : Replication_Info);
procedure Device_Replication (D : Replication_Info);
procedure Expand_Component (C : Replication_Info);
procedure Expand_Component_Implementation (I : Replication_Info);
procedure Extract_Properties_List (N : Node_Id);
procedure Check_Replication_Validity (Record_Info : Replication_Info);
function Check_Consensus_Algo_Validity
(Replicated_Component : Node_Id; Consensus_List : Node_List)
return boolean;
function Add_Connection (Source : Node_Id;
Destination : Node_Id;
Source_Port : Node_Id;
Destination_Port : Node_Id;
Parent_Comp_Impl : Node_Id;
Category : Ocarina.Me_AADL.Connection_Type
:= CT_Port_Connection)
return Node_Id;
-- Adding connection between source and destination
-- situated inside the Parent_Comp_Impl component
function Generate_Replica (Replicated_Component : Node_Id;
Identifiers_List : List_Id;
Comp_Category :
Ocarina.ME_AADL.Component_Category)
return List_Id;
-- Replicate the Replicated_Component component Replica_Number
-- onces and give them the Identifiers_List list of identifiers
function Add_Subcomponent (Loc : Location := No_Location;
Comp_Impl : Node_Id;
Category : Ocarina.ME_AADL.Component_Category;
Is_Refinement : Boolean;
In_Modes : Node_Id := No_Node;
Prototypes_Bindings : List_Id := No_List;
Entity_Ref : Node_Id := No_Node;
Identifier_Name : Name_Id)
return Node_Id;
function Get_Connection (Component : Node_Id;
Conn_Source : Node_Id)
return Node_Id;
-- return the connection of component which has as source
-- the parameter source if exist else No_Node
procedure Set_Property_Association_List (Pointed_Node : Node_Id;
Replica_List : List_Id;
Container : Node_Id);
-- Set the property association list to the different replica
-- by copying the ones of the replicated component
function Add_Component (Loc : Location;
Core_Name : Node_Id;
Namespace : Node_Id;
Component_Type :
Ocarina.ME_AADL.Component_Category;
Is_Private : Boolean := False;
Suffix_Name : String;
Implementation : Boolean := False)
return Node_Id;
-- return a node_Id representing the new created component type
-- if Implementation is false or component implementation if
-- Implementation is true with specifiying its identifier in both cases
-- The identifier of the new added component is the concatenation
-- of the core_name and the suffix_name
function Create_Call_Sequence_to_Wrapper
(T : Node_Id;
Wrapper_Spg_Impl : Node_Id)
return Node_Id;
-- Create Return the subprogram call node,
-- return no_node whenever declaration fail
procedure Add_Wrapper_Spg (Thread_Type : Node_Id;
Thread_Impl : Node_Id;
R : Replication_Info);
-- add the wrapper subprogram into the thread voter
-- and then create subprograms voters calling the
-- procedure Create_Voter_Subprograms
function Add_Subprogram_Parameter (Spg : Node_Id;
Feature : Node_Id;
Entity_Ref : Node_Id := No_Node)
return Node_Id;
-- Add the Feature into the subprogram Spg
procedure Create_Voter_Subprograms (R : Replication_Info;
Wrapper : Node_Id;
Wrapper_Impl : Node_Id);
-- Create the voter subprograms (Map and vote) for each
-- output of the replicated component
procedure Generate_Consensus (Consensus_Value : Node_Id;
Consensus_Type : Integer;
Feature_Node : Node_Id;
Wrapper_Spg : Node_Id;
Wrapper_Spg_Impl : Node_Id;
Replica_Number : Integer;
Call_Seq : Node_Id);
-- generates the mapping_Spg and Vote_Spg inside the Wrapper_Spg
-- depending on the Consensus_Type and Consensus_Value and connect
-- each of them to others
procedure Add_Source_Name (Spg : Node_Id;
Source_Name_Value : Node_Id);
-- Add the property source Name to the subprogram Spg
function Add_Spg_Call_To_Call_Seq (Call_Name : Name_Id;
Spg_Comp : Node_Id;
Call_Seq : Node_Id)
return Node_Id;
-- add a call_subprogram to a call_Sequence
procedure Copy_Property (N1 : Node_Id;
N2 : Node_Id;
Property_Node : Node_Id);
-- apply the property_value attributed to the property_name
-- to node N2 similarely to N1
procedure Set_Actual_Processor_Binding (P1 : Node_Id;
P2 : Node_Id;
Container : Node_Id);
-- Add the property Actual_Pocessor_Binding to process P2
-- by affecting the same value of the Property_Node
----------------------------------
-- Set_Actual_Processor_Binding --
----------------------------------
procedure Set_Actual_Processor_Binding (P1 : Node_Id;
P2 : Node_Id;
Container : Node_Id)
is
pragma Assert (kind (P1) = kind (P2));
Prop_Name : constant Name_Id
:= Get_String_Name ("Actual_Processor_Binding");
Prop_Node, Prop_Assoc : Node_Id := No_Node;
Properties_List : List_Id;
Applies_To : List_Id;
Applies_To_Node : Node_Id;
Found : Boolean := False;
begin
Properties_List := ATN.Properties (Container);
if (not ATNU.Is_Empty (Properties_List)) then
Prop_Node := First_Node (Properties_List);
end if;
while (Present (Prop_Node) and then not Found) loop
if (To_Lower (Name (Identifier (Property_Name (Prop_Node))))
= To_Lower (Prop_Name)) and then
(not ATNU.Is_Empty (Applies_To_Prop (Prop_Node)))
then
Applies_To := List_Items (First_Node
(Applies_To_Prop (Prop_Node)));
Applies_To_Node := First_Node (Applies_To);
while (Present (Applies_To_Node) and then not Found) loop
if Corresponding_Entity (Applies_To_Node) = P1
then
Prop_Assoc := Prop_Node;
Found := true;
end if;
Applies_To_Node := Next_Node (Applies_To_Node);
end loop;
if (Found) then
Copy_Property (P1, P2, Prop_Assoc);
end if;
end if;
Prop_Node := Next_Node (Prop_Node);
end loop;
end Set_Actual_Processor_Binding;
-------------------
-- Copy_Property --
-------------------
procedure Copy_Property (N1 : Node_Id;
N2 : Node_Id;
Property_Node : Node_Id)
is
-- Applies_To_Node : Node_Id;
Id, Id2, S2, S, N : Node_Id;
Applied_To, L : List_Id;
-- Applies_To_List, L : List_Id;
Prop_Name : Name_Id;
Property_Value : constant Node_Id
:= Property_Association_Value (Property_Node);
Value_Of_Association : constant Node_Id
:= New_Node (K_Property_Value, Loc (N1));
New_Comp_Name : Name_Id;
begin
Prop_Name := Name (Identifier (Property_Name (Property_Node)));
Id := ATNU.Make_Identifier
(No_Location, Prop_Name, Prop_Name, No_Node);
S2 := New_Node (K_Entity_Reference, No_Location);
Set_Identifier (S2, Id);
-- Create the property
L := New_List (K_List_Id, No_Location);
N := New_Node (K_Contained_Element_Path, No_Location);
Set_List_Items (N, L);
S := New_Node (K_Reference_Term, No_Location);
Set_Reference_Term (S, N);
Set_Full_Identifier (S2, Id);
New_Comp_Name := Name (Identifier (N2));
Applied_To := New_List (K_List_Id, No_Location);
Append_Node_To_List
(Make_Identifier
(No_Location, New_Comp_Name, New_Comp_Name, No_Node),
Applied_To);
Id2 := New_Node (K_Contained_Element_Path, No_Location);
Set_List_Items (Id2, Applied_To);
Applied_To := New_List (K_List_Id, No_Location);
Append_Node_To_List (Id2, Applied_To);
Id := Add_New_Property_Association
(Loc => No_Location,
Name => Id,
Property_Name => Property_Name (Property_Node),
Container => Container_Component (N1),
In_Binding => In_Binding (Property_Node),
In_Modes => In_Modes (Property_Node),
Property_Value => Single_Value (Property_Value),
Is_Constant => Is_Constant (Property_Node),
Is_Access => Is_Access (Property_Node),
Is_Additive => Is_Additive_Association
(Property_Node),
Applies_To => Applied_To);
if No (Id) then
raise Program_Error;
end if;
if Property_Value /= No_Node then
if (Multi_Value (Property_Value) /= No_List) then
-- and then kind (Multi_Value (Property_Value))
-- = K_Property_List_Value
Set_Single_Value (Value_Of_Association, No_Node);
Set_Multi_Value (Value_Of_Association,
Multi_Value (Property_Value));
else
Set_Single_Value (Value_Of_Association,
Single_Value (Property_Value));
Set_Multi_Value (Value_Of_Association, No_List);
end if;
else
Set_Single_Value (Value_Of_Association, No_Node);
Set_Multi_Value (Value_Of_Association, No_List);
end if;
Set_Property_Association_Value (Id, Value_Of_Association);
end Copy_Property;
--------------------------------
-- Remove_Node_From_Node_List --
--------------------------------
procedure Remove_Node_From_Node_List (Node : in out Node_Id;
List : in out Node_List)
is
pragma Assert (Present (Node));
Done : boolean := False;
Current, Last : Node_Id;
begin
if List.First /= No_Node and then
Is_Node_Of_Node_List (Node, List)
then
Current := List.First;
if Current = Node then
List.First := Next_Entity (Current);
Node := No_Node;
else
while Present (Current) and then not (Done) loop
Last := Current;
Current := Next_Entity (Current);
if Current = Node then
if Present (Next_Entity (Current)) then
List.Last := Next_Entity (Current);
else
List.Last := Last;
end if;
Node := No_Node;
Done := True;
else
Current := Next_Entity (Current);
end if;
end loop;
end if;
end if;
end Remove_Node_From_Node_List;
------------------------------
-- Add_Spg_Call_To_Call_Seq --
------------------------------
function Add_Spg_Call_To_Call_Seq (Call_Name : Name_Id;
Spg_Comp : Node_Id;
Call_Seq : Node_Id)
return Node_Id
is
pragma Assert (kind (Spg_Comp) = K_Component_Implementation);
pragma Assert (kind (Call_Seq) = K_Subprogram_Call_Sequence);
Node : Node_Id;
Success : Boolean := False;
Call_Spg_Name : Node_Id;
Path_Ref : constant List_Id := New_List (K_List_Id, No_Location);
C, Ref : Node_Id;
begin
Node := New_Node (K_Subprogram_Call, No_Location);
Call_Spg_Name := Make_Identifier (No_Location,
Call_Name,
Call_Name,
Node);
Set_Identifier (Node, Call_Spg_Name);
Ref := New_Node (K_Entity_Reference, No_Location);
C := New_Node (K_Node_Container, No_Location);
Set_Item (C, ATNU.Make_Identifier
(No_Location, Name (Identifier (Spg_Comp)),
Display_Name (Identifier (Spg_Comp)), No_Node));
ATNU.Append_Node_To_List (C, Path_Ref);
Set_Path (Ref, Path_Ref);
Set_Identifier (Ref, ATNU.Make_Identifier
(No_Location, Name (Identifier (Spg_Comp)),
Display_Name (Identifier (Spg_Comp)), No_Node));
Set_Entity_Ref (Node, Ref);
Success := Add_Subprogram_Call (Call_Seq, Node);
if (not Success) then
raise Program_Error;
end if;
return Node;
end Add_Spg_Call_To_Call_Seq;
---------------------
-- Add_Source_Name --
---------------------
procedure Add_Source_Name (Spg : Node_Id;
Source_Name_Value : Node_Id)
is
pragma Assert (Kind (Spg) = K_Component_Type or else
Kind (Spg) = K_Component_Implementation);
Source_Name_Str : constant String := "Source_Name";
Source_Name : constant Name_Id
:= Get_String_Name (Source_Name_Str);
S, S2, N, Id : Node_Id;
L : constant List_Id
:= New_List (K_List_Id, No_Location);
begin
Id := ATNU.Make_Identifier
(No_Location, Source_Name, Source_Name, No_Node);
S2 := New_Node (K_Entity_Reference, No_Location);
Set_Identifier (S2, Id);
-- Create the property
N := New_Node (K_Contained_Element_Path, No_Location);
Set_List_Items (N, L);
S := New_Node (K_Reference_Term, No_Location);
Set_Reference_Term (S, N);
Set_Full_Identifier (S2, Id);
Id := Add_New_Property_Association
(Loc => No_Location,
Name => Id,
Property_Name => S2,
Container => Spg,
In_Binding => No_Node,
In_Modes => No_Node,
Property_Value => Source_Name_Value,
Is_Constant => False,
Is_Access => False,
Is_Additive => False,
Applies_To => No_List);
if No (Id) then
raise Program_Error;
end if;
end Add_Source_Name;
------------------------
-- Generate_Consensus --
------------------------
procedure Generate_Consensus (Consensus_Value : Node_Id;
Consensus_Type : Integer;
Feature_Node : Node_Id;
Wrapper_Spg : Node_Id;
Wrapper_Spg_Impl : Node_Id;
Replica_Number : Integer;
Call_seq : Node_Id)
is
Map_Spg, Map_Spg_Impl : Node_Id := No_Node;
Vote_Spg, Vote_Spg_Impl : Node_Id := No_Node;
Data, Data_Impl : Node_Id := No_Node;
Param, Conn : Node_Id;
Map_Call, Vote_call : Node_Id;
Generated_Name : Name_Id;
Generated_feat : Integer;
Feature_Name : constant Name_Id
:= Name (Identifier (Feature_Node));
Voter_Param_Name : constant Name_Id
:= Get_String_Name ("Voter_Array");
Voter_Param, Map_Param : Node_Id;
Src : Name_Id;
Data_Source : Node_Id;
Entity : Node_Id;
begin
Data := Add_Component
(Loc (Wrapper_Spg),
Entity_Ref (Feature_Node),
Namespace (Wrapper_Spg),
CC_Data,
False, -- Is_Private
"_Array",
False); -- Comp Impl
Data_Impl := Add_Component
(Loc (Wrapper_Spg),
Data,
Namespace (Wrapper_Spg),
CC_Data,
False, -- Is_Private
".Impl",
True); -- Comp Impl
-- 1. Create the component subprogram declaration Map_Spg
Map_Spg := Add_Component
(Loc (Wrapper_Spg),
No_Node, -- core_name
Namespace (Wrapper_Spg),