* 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)

resources/AADLv2/replication_properties.aadl

+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;

resources/Makefile.am

@@ -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

src/backends/ocarina-backends-replication_expander.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                           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),
+                      CC_Subprogram,