---------------------------------------------------------- ---------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . P N . N U T I L S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-2007, 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; with Ocarina.Nodes; with Ocarina.Entities.Components.Connections; with Ocarina.Entities.Messages; with Ocarina.PN.Root; with Ocarina.AADL_Values; package body Ocarina.PN.Nutils is package ON renames Ocarina.Nodes; function Find_Corresponding_PN_Port (PN_Root, Port_Instance : Types.Node_Id) return Types.Node_Id; -- Find the node in the PN tree that corresponds to the node of -- the port in the instance tree ------------------------- -- Append_Node_To_List -- ------------------------- procedure Append_Node_To_List (E : Types.Node_Id; L : Types.List_Id) is use Types; use OPN; Last : Node_Id; begin Last := Last_Node (L); if No (Last) then Set_First_Node (L, E); else Set_Next_Node (Last, E); end if; Last := E; while Present (Last) loop Set_Last_Node (L, Last); Last := Next_Node (Last); end loop; end Append_Node_To_List; -------------- -- New_List -- -------------- function New_List (Kind : OPN.Node_Kind) return Types.List_Id is use Types; use Ocarina.PN.Nodes; begin return List_Id (New_Node (Kind)); end New_List; -------------- -- Is_Empty -- -------------- function Is_Empty (L : Types.List_Id) return Boolean is use OPN; use Types; begin return L = No_List or else No (First_Node (L)); end Is_Empty; -------------- -- New_Node -- -------------- function New_Node (Kind : OPN.Node_Kind) return Types.Node_Id is use OPN; use Types; N : Node_Id; begin Entries.Increment_Last; N := Entries.Last; Entries.Table (N) := Default_Node; Set_Kind (N, Kind); return N; end New_Node; -- ------------------------ -- -- Translate_Position -- -- ------------------------ -- function Translate_Position (P : Node_Id) return Node_Location -- is -- use Ocarina.AADL_Values; -- N : Node_Location; -- begin -- N.X := Integer (Ocarina.AADL_Values.Value (X_Value (P)).IVal); -- N.Y := Integer (Ocarina.AADL_Values.Value (Y_Value (P)).IVal); -- return N; -- end Translate_Position; -- ----------------------- -- -- Make_Include_Call -- -- ----------------------- -- function Make_Include_Call -- (Gaia_Instance, Gaia_Subprogram_Call : Node_Id) return Node_Id -- is -- N : constant Node_Id := New_Node (K_Include_Call); -- I, I2 : Node_Id; -- begin -- I := Map_Scoped_Name (GN.Scoped_Name (Gaia_Instance), N); -- I2 := Map_Scoped_Name (GN.Scoped_Name (Gaia_Subprogram_Call), N); -- Set_Subprogram_Scoped_Name (N, I2); -- Set_Namespace_Scoped_Name (N, I); -- return N; -- end Make_Include_Call; -- ----------------------- -- -- Make_Include_Call -- -- ----------------------- -- function Make_Include_Call -- (Prefix : String; Gaia_Call : Node_Id) return Node_Id -- is -- use Ocarina.AADL_Values; -- use Namet; -- N : constant Node_Id := New_Node (K_Include_Call); -- Scoped : constant Node_Id := New_Node (K_Scoped_Name); -- I, I2 : Node_Id; -- begin -- Set_Str_To_Name_Buffer (Prefix); -- I2 := Make_Identifier (Scoped, Name_Find); -- GPN.Set_Identifier (Scoped, I2); -- GPN.Set_Parent_Scoped_Name (Scoped, No_Node); -- I := Map_Scoped_Name (GN.Scoped_Name (Gaia_Call), N); -- Set_Subprogram_Scoped_Name (N, I); -- Set_Namespace_Scoped_Name (N, Scoped); -- return N; -- end Make_Include_Call; -- ------------------------ -- -- Add_Domain_To_List -- -- ------------------------ -- procedure Add_Domain_To_List (D : Node_Id; L : List_Id) is -- N : constant Node_Id := New_Node (K_Encapsulate_List_Node); -- begin -- Set_Refered_Node (N, D); -- Append_Node_To_List (N, L); -- end Add_Domain_To_List; -- ------------------------ -- -- Add_Domain_To_Node -- -- ------------------------ -- procedure Add_Domain_To_Node -- (D, N : Node_Id; Number : Value_Id := Ocarina.AADL_Values.V_One) -- is -- L : constant Node_Id := New_Node (K_Encapsulate_List_Node); -- K : List_Id; -- P : Node_Id; -- Found : Boolean := False; -- C : Node_Id; -- begin -- if Kind (N) = K_Connect_Statement then -- C := Make_Colored_Token (D, Number); -- Set_Refered_Node (L, C); -- K := Domains (N); -- if not Is_Empty (K) then -- P := First_Node (K); -- while P /= No_Node loop -- if Color_Declaration (Refered_Node (P)) = D then -- Found := True; -- exit; -- end if; -- P := Next_Node (P); -- end loop; -- end if; -- if not Found then -- Append_Node_To_List (L, Domains (N)); -- end if; -- else -- Set_Refered_Node (L, D); -- K := Domains (N); -- if not Is_Empty (K) then -- P := First_Node (K); -- while P /= No_Node loop -- if Refered_Node (P) = D then -- Found := True; -- exit; -- end if; -- P := Next_Node (P); -- end loop; -- end if; -- if not Found then -- Append_Node_To_List (L, Domains (N)); -- end if; -- end if; -- end Add_Domain_To_Node; -- ------------------------ -- -- Make_Colored_Token -- -- ------------------------ -- function Make_Colored_Token -- (Color : Node_Id; Number : Value_Id := Ocarina.AADL_Values.V_One) -- return Node_Id -- is -- N : constant Node_Id := New_Node (K_Colored_Token); -- begin -- Set_Color_Declaration (N, Color); -- Set_Number (N, Number); -- return N; -- end Make_Colored_Token; -- ---------------------------- -- -- Add_Token_Value_To_Arc -- -- ---------------------------- -- procedure Add_Token_Value_To_Arc -- (A : Node_Id; V : Value_Id; C : Node_Id) is -- L : constant Node_Id := New_Node (K_Encapsulate_List_Node); -- T : constant Node_Id := New_Node (K_Token); -- begin -- Set_Color (T, C); -- Set_Value (T, V); -- Set_Refered_Node (L, T); -- Append_Node_To_List (L, Domains (A)); -- end Add_Token_Value_To_Arc; -- ------------------------- -- -- Make_Symbolic_Value -- -- ------------------------- -- function Make_Symbolic_Value (N : Value_Id) return Node_Id -- is -- V : constant Node_Id := New_Node (K_Symbolic_Value); -- begin -- Set_Value_Name (V, N); -- return V; -- end Make_Symbolic_Value; -------------------- -- Make_Container -- -------------------- function Make_Container return Types.Node_Id is use OPN; use Types; Box : constant Node_Id := New_Node (K_Container); begin Set_Places (Box, New_List (K_List_Id)); Set_Arcs (Box, New_List (K_List_Id)); Set_Connections (Box, New_List (K_List_Id)); Set_Place_Fusions (Box, New_List (K_List_Id)); Set_Arc_Fusions (Box, New_List (K_List_Id)); Set_Subnets (Box, New_List (K_List_Id)); return Box; end Make_Container; -- ----------------------------- -- -- Make_Fonctionnal_Entity -- -- ----------------------------- -- function Make_Fonctionnal_Entity -- return Node_Id -- is -- Box : constant Node_Id := New_Node (GPN.K_Fonctionnal_Entity); -- begin -- GPN.Set_Places (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Transitions (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Connections (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Loop_Declarations (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Places_Fusions (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Transitions_Fusions (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Sub_Components (Box, New_List (GPN.K_List_Id)); -- GPN.Set_Begin_Node (Box, No_Node); -- GPN.Set_End_Node (Box, No_Node); -- GPN.Set_Include_Call (Box, No_Node); -- return Box; -- end Make_Fonctionnal_Entity; --------------------- -- Make_Identifier -- --------------------- function Make_Identifier (Pn_Entity : Types.Node_Id; Ident_Name : Types.Name_Id) return Types.Node_Id is use OPN; use Types; Identify : constant Node_Id := New_Node (K_Identifier); begin Set_Corresponding_Entity (Identify, Pn_Entity); Set_Name (Identify, Ident_Name); Set_Ocarina_Node (Identify, No_Node); return Identify; end Make_Identifier; -- --------------------------------- -- -- Make_Transition_Declaration -- -- --------------------------------- -- function Make_Transition_Declaration -- (Suffix : Name_Id; Parent : Node_Id) -- return Node_Id -- is -- use Ocarina.AADL_Values; -- pragma Assert (Parent = No_Node or else -- (Kind (Parent) = K_Container or else -- Kind (Parent) = K_Root_Node or else -- Kind (Parent) = K_Fonctionnal_Entity)); -- Transition_Decl : constant Node_Id := New_Node -- (K_Transition_Declaration); -- Scoped : Node_Id; -- begin -- Set_Identifier (Transition_Decl, Make_Identifier -- (Transition_Decl, Suffix)); -- Scoped := Make_Scoped_Name (Transition_Decl, Suffix); -- Set_Parent_Scoped_Name (Scoped, Scoped_Name (Parent)); -- Set_Scoped_Name (Transition_Decl, Scoped); -- Set_Guard (Transition_Decl, No_Node); -- return Transition_Decl; -- end Make_Transition_Declaration; -- ------------------- -- -- Make_Position -- -- ------------------- -- procedure Make_Position (N : in out Node_Id; P : Node_Location) -- is -- use Ocarina.AADL_Values; -- Pos : constant Node_Id := New_Node (K_Position); -- begin -- GPN.Set_X_Value (Pos, New_Integer_Value (Unsigned_Long_Long --(P.X))); -- GPN.Set_Y_Value (Pos, New_Integer_Value (Unsigned_Long_Long --(P.Y))); -- GPN.Set_Position (N, Pos); -- end Make_Position; ------------------------ -- Make_Unequal_Guard -- ------------------------ function Make_Unequal_Guard (Var, Cst : Types.Value_Id) return Types.Node_Id is use Types; use Ocarina.PN.Nodes; Node : constant Node_Id := New_Node (K_Guard); begin Set_Variable (Node, Var); Set_Value (Node, Cst); Set_Operator (Node, Guard_Unequality); return Node; end Make_Unequal_Guard; ---------------------- -- Make_Equal_Guard -- ---------------------- function Make_Equal_Guard (Var, Cst : Types.Value_Id) return Types.Node_Id is use Types; use Ocarina.PN.Nodes; Node : constant Node_Id := New_Node (K_Guard); begin Set_Variable (Node, Var); Set_Value (Node, Cst); Set_Operator (Node, Guard_Equality); return Node; end Make_Equal_Guard; -- ------------------------ -- -- Add_Token_To_Place -- -- ------------------------ -- procedure Add_Token_To_Place (P : Node_Id; V : Value_Id; C : --Node_Id) is -- pragma Assert (Kind (P) = K_Place_Declaration); -- pragma Assert (Kind (C) = K_Color_Declaration); -- T : constant Node_Id := New_Node (K_Token); -- begin -- Set_Value (T, V); -- Set_Color (T, C); -- Append_Node_To_List (T, Tokens (P)); -- end Add_Token_To_Place; ---------------------------- -- Make_Place_Declaration -- ---------------------------- function Make_Place_Declaration (Place_Name : Types.Name_Id; Color_Class : Types.Node_Id; Initial_Marking : Types.Node_Id := Types.No_Node) return Types.Node_Id is use Ocarina.PN.Nodes; use Types; pragma Assert (Initial_Marking = No_Node or else Kind (Initial_Marking) = K_PN_Marking); Decl : constant Node_Id := New_Node (K_Place_Declaration); begin Set_Identifier (Decl, Make_Identifier (Decl, Place_Name)); Set_Position (Decl, No_Node); Set_Color (Decl, Color_Class); Set_Marking (Decl, Initial_Marking); return Decl; end Make_Place_Declaration; --------------------------------- -- Make_Transition_Declaration -- --------------------------------- function Make_Transition_Declaration (Transition_Name : Types.Name_Id) return Types.Node_Id is use Ocarina.PN.Nodes; use Types; Decl : constant Node_Id := New_Node (K_Transition_Declaration); begin Set_Identifier (Decl, Make_Identifier (Decl, Transition_Name)); Set_Position (Decl, No_Node); Set_Guards (Decl, New_List (K_List_Id)); return Decl; end Make_Transition_Declaration; -- ------------------------ -- -- Make_Embedded_Node -- -- ------------------------ -- function Make_Embedded_Node (N : Node_Id) return Node_Id is -- P : constant Node_Id := New_Node (K_Encapsulate_List_Node); -- begin -- Set_Refered_Node (P, N); -- return P; -- end Make_Embedded_Node; -- ------------------------ -- -- Make_Port_Location -- -- ------------------------ -- procedure Make_Port_Location (P : Node_Id; L : Node_Location) is -- N : Node_Id; -- begin -- if Refered_Nodes (P) /= No_List then -- N := Refered_Node (First_Node (Refered_Nodes (P))); -- Make_Position (N, L); -- end if; -- end Make_Port_Location; -- ------------------------- -- -- Make_Fifos_Location -- -- ------------------------- -- procedure Make_Fifos_Location (F : Node_Id; L : Node_Location) is -- pragma Assert (Kind (F) = K_Fifo_Extremities); -- List_Node : Node_Id; -- N : Node_Id; -- begin -- if Refered_Nodes (F) /= No_List then -- List_Node := First_Node (Refered_Nodes (F)); -- while Present (List_Node) loop -- N := Refered_Node (List_Node); -- Make_Position (N, L); -- Set_Refered_Node (List_Node, N); -- List_Node := GPN.Next_Node (List_Node); -- end loop; -- end if; -- end Make_Fifos_Location; ------------------ -- Make_Marking -- ------------------ function Make_Marking (Token : Types.Node_Id; Is_Tuple : Boolean := True) return Types.Node_Id is use Types; use Ocarina.PN.Nodes; pragma Assert (Token = No_Node or else Kind (Token) = K_Color_Variable); Marking : constant Node_Id := New_Node (K_PN_Marking); begin Set_Tuple (Marking, Is_Tuple); Set_Tokens (Marking, New_List (K_List_Id)); if Token /= No_Node then Append_Node_To_List (Token, Tokens (Marking)); end if; return Marking; end Make_Marking; -------------------------- -- Add_Token_To_Marking -- -------------------------- procedure Add_Token_To_Marking (Marking, Token : Types.Node_Id) is use Types; use Ocarina.PN.Nodes; pragma Assert (Marking /= No_Node and then Kind (Marking) = K_PN_Marking); pragma Assert (Token /= No_Node and then Kind (Token) = K_Color_Variable); begin Append_Node_To_List (Token, Tokens (Marking)); end Add_Token_To_Marking; ------------------------- -- Make_Color_Variable -- ------------------------- function Make_Color_Variable (Name : Types.Value_Id) return Types.Node_Id is use OPN; use Types; Color : constant Node_Id := New_Node (K_Color_Variable); begin Set_Value (Color, Name); return Color; end Make_Color_Variable; --------------------- -- Make_Connection -- --------------------- function Make_Connection (Srce, Dest : Types.Node_Id; Marking : Types.Node_Id) return Types.Node_Id is use Types; use Ocarina.PN.Nodes; pragma Assert (Srce /= No_Node and then (Kind (Srce) = K_Place_Declaration or else Kind (Srce) = K_Transition_Declaration or else Kind (Srce) = K_Port)); pragma Assert (Dest /= No_Node and then (Kind (Dest) = K_Place_Declaration or else Kind (Dest) = K_Transition_Declaration or else Kind (Dest) = K_Port)); pragma Assert (Marking = No_Node or else Kind (Marking) = K_PN_Marking); Connect : constant Node_Id := New_Node (K_Connect_Statement); begin Set_First_Reference (Connect, Srce); Set_Second_Reference (Connect, Dest); Set_Marking (Connect, Marking); return Connect; end Make_Connection; ------------------------ -- Make_PN_Connection -- ------------------------ function Make_PN_Connection (PN_Root, Virtual_Connection : Types.Node_Id) return Types.Node_Id is use Types; use Namet; use Ocarina.Entities.Components.Connections; use Ocarina.PN.Root; use Ocarina.AADL_Values; use ON; use OPN; pragma Assert (PN_Root /= No_Node and then OPN.Kind (PN_Root) = K_Root_Node); pragma Assert (Virtual_Connection /= No_Node and then ON.Kind (Virtual_Connection) = K_Virtual_Connection); PN_Connection : constant Node_Id := New_Node (K_Connection); Dest : constant Node_Id := New_Node (K_Indirection); Type_Of_Connection : Connection_Type; begin Set_Connection_Transition (PN_Connection, New_Node (K_Transition_Declaration)); OPN.Set_Source (PN_Connection, Find_Corresponding_PN_Port (PN_Root, ON.Source (Virtual_Connection))); Get_Name_String (OPN.Name (OPN.Identifier (OPN.Source (PN_Connection)))); Add_Str_To_Name_Buffer ("_cnx"); OPN.Set_Identifier (Connection_Transition (PN_Connection), Make_Identifier (PN_Connection, Name_Find)); OPN.Set_Destinations (PN_Connection, New_List (K_List_Id)); Set_Arcs (PN_Connection, New_List (K_List_Id)); OPN.Set_Item (Dest, Find_Corresponding_PN_Port (PN_Root, Destination (Virtual_Connection))); Append_Node_To_List (Dest, OPN.Destinations (PN_Connection)); -- Type_Of_Connection := -- Get_Category_Of_Connection -- (ON.Item (ON.Last_Node (Connection_Instances --(Virtual_Connection)))); Type_Of_Connection := CT_Event_Data; -- XXX This is a dirty workaround, since there is a bug in -- mknodes that prevents from managing the field Category -- correctly. Hence we assimilate all inter-thread connections -- with event data connections. case Type_Of_Connection is when CT_Data | CT_Data_Delayed | CT_Parameter => OPN.Set_Is_Event (PN_Connection, False); when CT_Event | CT_Event_Data | CT_Port_Group | CT_Access_Bus | CT_Access_Data | CT_Access_Subprogram => OPN.Set_Is_Event (PN_Connection, True); end case; -- Many of these cases won't occur (e.g. ct_port_group) if not OPN.Is_Event (PN_Connection) then Append_Node_To_List (Make_Unequal_Guard (Var => OPN.Value (Get_New_Value_Variable (PN_Root, No_Node)), Cst => New_String_Value (Undefined_Value_Variable)), Guards (Connection_Transition (PN_Connection))); end if; if OPN.Item (Dest) = No_Node then -- We did not find any destination PN place return No_Node; else return PN_Connection; end if; end Make_PN_Connection; ---------------------------------- -- Aggregate_Virtual_Connection -- ---------------------------------- function Aggregate_Virtual_Connection (PN_Root, Virtual_Connection, PN_Connection : Types.Node_Id) return Boolean is use Types; use ON; use OPN; pragma Assert (PN_Root /= No_Node and then OPN.Kind (PN_Root) = K_Root_Node); pragma Assert (Virtual_Connection /= No_Node and then ON.Kind (Virtual_Connection) = K_Virtual_Connection); pragma Assert (PN_Connection /= No_Node and then OPN.Kind (PN_Connection) = K_Connection); Dest : constant Node_Id := New_Node (K_Indirection); begin OPN.Set_Item (Dest, Find_Corresponding_PN_Port (PN_Root, Destination (Virtual_Connection))); Append_Node_To_List (Dest, OPN.Destinations (PN_Connection)); return OPN.Item (Dest) /= No_Node; end Aggregate_Virtual_Connection; -------------------------------- -- Find_Corresponding_PN_Port -- -------------------------------- function Find_Corresponding_PN_Port (PN_Root, Port_Instance : Types.Node_Id) return Types.Node_Id is use Types; use ON; use OPN; pragma Assert (PN_Root /= No_Node and then OPN.Kind (PN_Root) = K_Root_Node); pragma Assert (Port_Instance /= No_Node and then (ON.Kind (Port_Instance) = K_Port_Spec_Instance or else ON.Kind (Port_Instance) = K_Parameter_Instance or else ON.Kind (Port_Instance) = K_Subcomponent_Access_Instance or else Ocarina.Entities.Messages.DNKE (Port_Instance))); List_Node, Port_Node : Node_Id; begin if not Is_Empty (Subnets (PN_Root)) then List_Node := OPN.First_Node (Subnets (PN_Root)); while List_Node /= No_Node loop if Kind (List_Node) = K_Thread_Box and then not Is_Empty (Ports (List_Node)) then Port_Node := OPN.First_Node (Ports (List_Node)); while Port_Node /= No_Node loop if Corresponding_Feature (Port_Node) = Port_Instance then return Port_Node; end if; Port_Node := OPN.Next_Node (Port_Node); end loop; end if; List_Node := OPN.Next_Node (List_Node); end loop; end if; return No_Node; end Find_Corresponding_PN_Port; -- ----------------------- -- -- Make_Place_Fusion -- -- ----------------------- -- function Make_Place_Fusion -- (Node_1, Node_2, New_Name : Node_Id) -- return Node_Id -- is -- pragma Assert (New_Name /= No_Node and then -- GPN.Kind (New_Name) = GPN.K_Scoped_Name); -- pragma Assert (Node_1 /= No_Node and then -- GPN.Kind (Node_1) = GPN.K_Place_Declaration); -- pragma Assert (Node_2 /= No_Node and then -- GPN.Kind (Node_2) = GPN.K_Place_Declaration); -- Fusion : Node_Id; -- begin -- Fusion := New_Node (K_Place_Fusion); -- Set_First_Reference (Fusion, Node_1); -- Set_Second_Reference (Fusion, Node_2); -- Set_New_Scoped_Name (Fusion, New_Name); -- return Fusion; -- end Make_Place_Fusion; end Ocarina.PN.Nutils;