-------------------------------------------------------- ------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . P N . P R I N T E R -- -- -- -- 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 Output; with GNAT.OS_Lib; with Namet; with Ocarina.PN.Nodes; with Ocarina.PN.Nutils; with Ocarina.PN.Utils; with Ocarina.PN.Messages; with Ocarina.AADL_Values; with Ocarina.PN.Printer.Components; package body Ocarina.PN.Printer is package OPN renames Ocarina.PN.Nodes; package OPNU renames Ocarina.PN.Nutils; package OAV renames Ocarina.AADL_Values; ---------------------- -- Printer Routines -- ---------------------- procedure Print_Container (Box : Types.Node_Id); procedure Print_Fonctionnal_Entity (Box : Types.Node_Id); procedure Print_Subcomponents (Box : Types.Node_Id); procedure Print_Thread_Connection (Thread_Connection : Types.Node_Id); procedure Print_Guards (Guard_List : Types.List_Id); procedure Print_Domain (D : Types.Node_Id); procedure Print_Markings (Marking : Types.Node_Id); procedure Print_Position (Position : Types.Node_Id); -- procedure Print_Arc_Color (A : Node_Id); procedure Print_Include (Call : Types.Node_Id); procedure Print_Place_Fusion (Fusion : Types.Node_Id); procedure Print_PN_Color_Declarations (Root : Types.Node_Id); procedure Print_Header_Box; function Get_Name_Of_PN_Entity (Node : Types.Node_Id) return String; --------------------------- -- Get_Name_Of_PN_Entity -- --------------------------- function Get_Name_Of_PN_Entity (Node : Types.Node_Id) return String is use Namet; use Types; use Ocarina.PN.Nodes; pragma Assert (Node /= No_Node); begin return Get_Name_String (Name (Identifier (Node))); end Get_Name_Of_PN_Entity; ---------------------------------- -- Print_Transition_Declaration -- ---------------------------------- procedure Print_Transition_Declaration (Transition : Types.Node_Id) is use Types; use OAV; use Output; use Ocarina.PN.Nodes; pragma Assert (Transition /= No_Node and then OPN.Kind (Transition) = OPN.K_Transition_Declaration); begin Write_Str ("create transition """); Write_Str (Get_Name_Of_PN_Entity (Transition)); Write_Str (""" ("); Print_Position (Position (Transition)); Print_Guards (Guards (Transition)); Write_Line (");"); end Print_Transition_Declaration; ----------------------------- -- Print_Place_Declaration -- ----------------------------- procedure Print_Place_Declaration (Place : Types.Node_Id) is use Types; use Output; use OAV; use Ocarina.PN.Nodes; use Ocarina.PN.Messages; pragma Assert (Place /= No_Node and then (Kind (Place) = K_Place_Declaration or else Kind (Place) = K_Port or else DNKE (Place))); begin Write_Str ("create place """); Write_Str (Get_Name_Of_PN_Entity (Place)); Write_Str (""" ("); Print_Domain (Color (Place)); Write_Str (", "); Print_Position (Position (Place)); if Marking (Place) /= No_Node then Write_Str (", marking "); Print_Markings (Marking (Place)); end if; Write_Line (");"); end Print_Place_Declaration; ------------------ -- Print_Guards -- ------------------ procedure Print_Guards (Guard_List : Types.List_Id) is use Types; use Output; use Ocarina.PN.Nodes; use Ocarina.PN.Nutils; use Ocarina.AADL_Values; List_Node : Node_Id; begin if not Is_Empty (Guard_List) then Write_Str (", guard ""["); List_Node := First_Node (Guard_List); while List_Node /= No_Node loop if Kind (List_Node) = K_Guard then Write_Str (Image (Variable (List_Node), False)); Write_Str (" " & Image (Operator (List_Node), False) & " "); Write_Str (Image (Value (List_Node), False)); else raise Program_Error; end if; if List_Node /= Last_Node (Guard_List) then Write_Str (" && "); end if; List_Node := Next_Node (List_Node); end loop; Write_Str ("]"""); end if; end Print_Guards; ------------------ -- Print_Domain -- ------------------ procedure Print_Domain (D : Types.Node_Id) is use Output; begin Write_Str ("domain """); Write_Str (Get_Name_Of_PN_Entity (D)); Write_Str (""""); end Print_Domain; -------------------- -- Print_Position -- -------------------- procedure Print_Position (Position : Types.Node_Id) is use OAV; use Types; use Output; use Ocarina.PN.Nodes; begin if Position /= No_Node then Write_Str ("x " & OAV.Image (Y_Value (Position)) & ", y " & OAV.Image (X_Value (Position))); else Write_Str ("x 10, y 10"); end if; end Print_Position; -------------------- -- Print_Markings -- -------------------- procedure Print_Markings (Marking : Types.Node_Id) is use Types; use OAV; use Output; use Ocarina.PN.Nodes; use Ocarina.PN.Nutils; pragma Assert (Marking = No_Node or else Kind (Marking) = K_PN_Marking); List_Node : Node_Id; begin if Marking /= No_Node and then not Is_Empty (Tokens (Marking)) then List_Node := First_Node (Tokens (Marking)); if Tuple (Marking) then Write_Str (" ""<"); while List_Node /= No_Node loop Write_Str (Image (Value (List_Node), False)); if List_Node = Last_Node (Tokens (Marking)) then Write_Str (">"); else Write_Str (","); end if; List_Node := Next_Node (List_Node); end loop; else Write_Str (" """); while List_Node /= No_Node loop Write_Str ("<"); Write_Str (Image (Value (List_Node), False)); Write_Str (">"); if List_Node /= Last_Node (Tokens (Marking)) then Write_Str ("+"); end if; List_Node := Next_Node (List_Node); end loop; end if; Write_Str (""" "); end if; end Print_Markings; ------------------------- -- Print_PN_Connection -- ------------------------- procedure Print_PN_Connection (Connect : Types.Node_Id) is use Types; use Output; use Ocarina.PN.Nodes; use Ocarina.PN.Messages; pragma Assert (Connect /= No_Node and then (Kind (Connect) = K_Connect_Statement or else DNKE (Connect))); begin Write_Str ("connect"); Print_Markings (Marking (Connect)); if Kind (First_Reference (Connect)) = K_Place_Declaration or else Kind (First_Reference (Connect)) = K_Port then Write_Str ("place """); Write_Str (Get_Name_Of_PN_Entity (First_Reference (Connect))); Write_Str (""" to transition """); Write_Str (Get_Name_Of_PN_Entity (Second_Reference (Connect))); Write_Line (""";"); else Write_Str ("transition """); Write_Str (Get_Name_Of_PN_Entity (First_Reference (Connect))); Write_Str (""" to place """); Write_Str (Get_Name_Of_PN_Entity (Second_Reference (Connect))); Write_Line (""";"); end if; end Print_PN_Connection; --------------------- -- Print_Arc_Color -- --------------------- -- procedure Print_Arc_Color (A : Node_Id) is -- use Ocarina.AADL_Values; -- N : Node_Id; -- V : Node_Id; -- begin -- N := First_Node (Domains (A)); -- if N /= No_Node then -- Write_Str (""""); -- while N /= No_Node loop -- if Kind (Refered_Node (N)) /= K_Token then -- V := Color_Variable (Color_Declaration (Refered_Node --(N))); -- if Number (Refered_Node (N)) /= V_One then -- Write_Str (OAV.Image (Number (Refered_Node (N))) & --"*"); -- end if; -- Write_Str ("<"); -- Write_Str (Get_Name_Of_PN_Entity (V) & ">"); -- if Next_Node (N) /= No_Node then -- Write_Str ("+"); -- end if; -- else -- Write_Str ("<"); -- Write_Str (Get_Name_Of_PN_Entity (Color (Refered_Node (N))) & --"."); -- Write_Str (OAV.Image (Value (Refered_Node (N)), False) & --">"); -- if Next_Node (N) /= No_Node then -- Write_Str ("+"); -- end if; -- end if; -- N := Next_Node (N); -- end loop; -- Write_Str (""" "); -- end if; -- end Print_Arc_Color; ------------------- -- Print_Include -- ------------------- procedure Print_Include (Call : Types.Node_Id) is use Types; use Output; use Ocarina.PN.Nodes; pragma Assert (Call /= No_Node and then OPN.Kind (Call) = OPN.K_Include_Call); begin Write_Str ("#include "); -- Write_Str (Get_Scoped_Name (Namespace_Scoped_Name (Call)) & " "); -- Write_Line (Get_Scoped_Name (Subprogram_Scoped_Name (Call))); end Print_Include; ------------------------ -- Print_Place_Fusion -- ------------------------ procedure Print_Place_Fusion (Fusion : Types.Node_Id) is use Types; use Output; use Ocarina.PN.Nodes; pragma Assert (Fusion /= No_Node and then OPN.Kind (Fusion) = OPN.K_Place_Fusion); begin Write_Str ("merge place """); Write_Str (Get_Name_Of_PN_Entity (OPN.First_Reference (Fusion))); Write_Str (""" and place """); Write_Str (Get_Name_Of_PN_Entity (OPN.Second_Reference (Fusion))); Write_Str (""""); -- if OPN.New_Scoped_Name (Fusion) /= No_Node then -- Write_Str (" into name "); -- if Full_Naming_Policy then -- Write_Str ("""" & Get_Scoped_Name -- (OPN.New_Scoped_Name (Fusion)) & """"); -- else -- Write_Str ("""" & Get_Scoped_Name -- (OPN.New_Scoped_Name (Fusion)) & "_m"""); -- end if; -- end if; Write_Line (";"); end Print_Place_Fusion; ------------------------- -- Print_Subcomponents -- ------------------------- procedure Print_Subcomponents (Box : Types.Node_Id) is use OAV; use Output; begin case OPN.Kind (Box) is when OPN.K_Container => Write_Line (""); Write_Line ("-- " & Get_Name_Of_PN_Entity (Box)); Print_Container (Box); when OPN.K_Functionnal_Entity => Write_Line (""); Write_Line ("-- " & Get_Name_Of_PN_Entity (Box)); Print_Fonctionnal_Entity (Box); when OPN.K_Thread_Box => Write_Line (""); Write_Str ("-- thread " & Get_Name_Of_PN_Entity (Box) & " "); Write_Line ("(th_" & Image (Integer (Box)) & ")"); Write_Line (""); Print_Fonctionnal_Entity (Box); when others => raise Program_Error; end case; end Print_Subcomponents; ------------------------------ -- Print_Fonctionnal_Entity -- ------------------------------ procedure Print_Fonctionnal_Entity (Box : Types.Node_Id) is use Types; use Ocarina.PN.Nutils; use Ocarina.PN.Nodes; pragma Assert (Box /= No_Node and then (OPN.Kind (Box) = K_Functionnal_Entity or else OPN.Kind (Box) = K_Thread_Box)); A_Node : Node_Id; begin -- We expense include call if Include_Call (Box) /= No_Node then Print_Include (Include_Call (Box)); end if; -- We create the local places if not OPNU.Is_Empty (OPN.Places (Box)) then A_Node := OPN.First_Node (OPN.Places (Box)); while A_Node /= No_Node loop Print_Place_Declaration (A_Node); A_Node := OPN.Next_Node (A_Node); end loop; end if; -- We create the local transitions if not OPNU.Is_Empty (OPN.Arcs (Box)) then A_Node := OPN.First_Node (OPN.Arcs (Box)); while A_Node /= No_Node loop Print_Transition_Declaration (A_Node); A_Node := OPN.Next_Node (A_Node); end loop; end if; -- TODO : -- Create loop declaration here -- Process subcomponents if not OPNU.Is_Empty (OPN.Subnets (Box)) then A_Node := OPN.First_Node (OPN.Subnets (Box)); while A_Node /= No_Node loop Print_Subcomponents (A_Node); A_Node := OPN.Next_Node (A_Node); end loop; end if; -- We create the local connections if not OPNU.Is_Empty (OPN.Connections (Box)) then A_Node := OPN.First_Node (OPN.Connections (Box)); while A_Node /= No_Node loop Print_PN_Connection (A_Node); A_Node := OPN.Next_Node (A_Node); end loop; end if; -- Declare fusions if not Is_Empty (Place_Fusions (Box)) then A_Node := OPN.First_Node (OPN.Place_Fusions (Box)); while Present (A_Node) loop Print_Place_Fusion (A_Node); A_Node := OPN.Next_Node (A_Node); end loop; end if; end Print_Fonctionnal_Entity; --------------------- -- Print_Container -- --------------------- procedure Print_Container (Box : Types.Node_Id) is use Types; use Ocarina.PN.Nodes; use Ocarina.PN.Nutils; pragma Assert (Box /= No_Node and then (Kind (Box) = K_Container or else Kind (Box) = K_Thread_Box)); List_Node : Node_Id; begin -- We create the local places if not Is_Empty (Places (Box)) then List_Node := First_Node (Places (Box)); while List_Node /= No_Node loop Print_Place_Declaration (List_Node); List_Node := Next_Node (List_Node); end loop; end if; -- We create the local transitions if not Is_Empty (Arcs (Box)) then List_Node := First_Node (Arcs (Box)); while List_Node /= No_Node loop Print_Transition_Declaration (List_Node); List_Node := Next_Node (List_Node); end loop; end if; -- TODO : -- Create loop declaration here -- Process subcomponents if not Is_Empty (Subnets (Box)) then List_Node := First_Node (Subnets (Box)); while List_Node /= No_Node loop Print_Subcomponents (List_Node); List_Node := Next_Node (List_Node); end loop; end if; -- We create the local connections if not Is_Empty (Connections (Box)) then List_Node := First_Node (Connections (Box)); while List_Node /= No_Node loop Print_PN_Connection (List_Node); List_Node := Next_Node (List_Node); end loop; end if; -- Declare fusions if not Is_Empty (Place_Fusions (Box)) then List_Node := First_Node (Place_Fusions (Box)); while List_Node /= No_Node loop Print_Place_Fusion (List_Node); List_Node := Next_Node (List_Node); end loop; end if; end Print_Container; ----------------------------- -- Print_Thread_Connection -- ----------------------------- procedure Print_Thread_Connection (Thread_Connection : Types.Node_Id) is use Types; use Ocarina.PN.Nodes; pragma Assert (Thread_Connection /= No_Node and then Kind (Thread_Connection) = K_Connection); List_Node : Node_Id; begin Print_Transition_Declaration (Connection_Transition (Thread_Connection)); List_Node := First_Node (Arcs (Thread_Connection)); while List_Node /= No_Node loop Print_PN_Connection (List_Node); List_Node := Next_Node (List_Node); end loop; end Print_Thread_Connection; --------------------- -- Print_Root_Node -- --------------------- procedure Print_Root_Node (Root : Types.Node_Id; Options : Ocarina.PN.PN_Options) is use Types; use Namet; use Ocarina.PN.Utils; use Ocarina.PN.Nutils; use Ocarina.PN.Messages; use Ocarina.PN.Nodes; use Ocarina.PN.Printer.Components; use GNAT.OS_Lib; use Output; pragma Assert (Root /= No_Node and then OPN.Kind (Root) = OPN.K_Root_Node); List_Node : Node_Id; Model_Desc : GNAT.OS_Lib.File_Descriptor; begin Create_Directory (Options.Output_Directory); Enter_Directory (Options.Output_Directory); Model_Desc := Create_File ("partition.psc", Binary); if Model_Desc = Invalid_FD then Display_Error ("Could not create partition.psc in " & Get_Name_String (Options.Output_Directory), Fatal => True); else Display_Message ("Creating partition.psc in " & Get_Name_String (Options.Output_Directory)); end if; Set_Output (Model_Desc); -- Print Headers Print_Header_Box; Print_PN_Color_Declarations (Root); -- Process the application nodes if not Is_Empty (Subnets (Root)) then List_Node := First_Node (Subnets (Root)); while List_Node /= No_Node loop case Kind (List_Node) is when K_Thread_Box => Print_Thread_Box (List_Node); when K_Container => Print_Container (List_Node); when others => null; end case; List_Node := Next_Node (List_Node); end loop; end if; -- Process the connections between threads Write_Eol; Write_Line ("-- Thread connections"); Write_Line ("--"); if not Is_Empty (Connections (Root)) then List_Node := First_Node (Connections (Root)); while List_Node /= No_Node loop Print_Thread_Connection (List_Node); List_Node := Next_Node (List_Node); Write_Eol; end loop; end if; -- connections between places and transitions Write_Line ("-- Feedback connections"); Write_Line ("--"); if not Is_Empty (Arcs (Root)) then List_Node := First_Node (Arcs (Root)); while List_Node /= No_Node loop Print_PN_Connection (List_Node); List_Node := Next_Node (List_Node); end loop; end if; -- Close the file we wrote Set_Standard_Output; Close (Model_Desc); Leave_Directory; end Print_Root_Node; --------------------------------- -- Print_PN_Color_Declarations -- --------------------------------- procedure Print_PN_Color_Declarations (Root : Types.Node_Id) is use OAV; use Output; use Namet; use Types; use Ocarina.PN.Nodes; use Ocarina.PN.Nutils; pragma Assert (Root /= No_Node and then Kind (Root) = K_Root_Node); List_Node, List_Node2 : Node_Id; begin -- Make_Control_Color; Write_Str ("set net to declaration """); -- Class declarations if not Is_Empty (Color_Declarations (Root)) then List_Node := First_Node (Color_Declarations (Root)); Write_Str ("Class "); while List_Node /= No_Node loop if Kind (List_Node) = K_Enumeration_Class_Declaration then Write_Str (" / "); Write_Str (Get_Name_String (Name (Identifier (List_Node)))); Write_Str (" is ["); if not Is_Empty (Symbolic_Values (List_Node)) then List_Node2 := First_Node (Symbolic_Values (List_Node)); while List_Node2 /= No_Node loop Write_Str (Image (Value (List_Node2), Quoted => False)); if List_Node2 /= Last_Node (Symbolic_Values (List_Node)) then Write_Str (","); end if; List_Node2 := Next_Node (List_Node2); end loop; Write_Str ("]; "); end if; elsif Kind (List_Node) = K_Range_Class_Declaration then Write_Str (" / "); Write_Str (Get_Name_String (Name (Identifier (List_Node)))); Write_Str (" is "); Write_Str (Image (Lower_Value (List_Node), Quoted => False)); Write_Str (" .. "); Write_Str (Image (Higher_Value (List_Node), Quoted => False)); Write_Str ("; "); end if; List_Node := Next_Node (List_Node); end loop; end if; -- Domain declaration if not Is_Empty (Color_Declarations (Root)) then List_Node := First_Node (Color_Declarations (Root)); Write_Str ("/ Domain "); while List_Node /= No_Node loop if Kind (List_Node) = K_Domain_Declaration then Write_Str (" / "); Write_Str (Get_Name_String (Name (Identifier (List_Node)))); Write_Str (" is <"); if not Is_Empty (Classes (List_Node)) then List_Node2 := First_Node (Classes (List_Node)); while List_Node2 /= No_Node loop Write_Str (Image (Value (List_Node2), Quoted => False)); if List_Node2 /= Last_Node (Classes (List_Node)) then Write_Str (","); end if; List_Node2 := Next_Node (List_Node2); end loop; Write_Str (">; "); end if; end if; List_Node := Next_Node (List_Node); end loop; end if; -- Variables if not Is_Empty (Color_Declarations (Root)) then List_Node := First_Node (Color_Declarations (Root)); Write_Str ("/ Var "); while List_Node /= No_Node loop if Kind (List_Node) = K_Variables_Declaration then if not Is_Empty (Variables (List_Node)) then List_Node2 := First_Node (Variables (List_Node)); Write_Str ("/ "); while List_Node2 /= No_Node loop Write_Str (Image (Value (List_Node2), Quoted => False)); if List_Node2 /= Last_Node (Variables (List_Node)) then Write_Str (", "); end if; List_Node2 := Next_Node (List_Node2); end loop; Write_Str (" in "); Write_Str (Get_Name_String (Name (Identifier (List_Node)))); Write_Str ("; "); end if; end if; List_Node := Next_Node (List_Node); end loop; end if; Write_Line (""";"); end Print_PN_Color_Declarations; ---------------------- -- Print_Header_Box -- ---------------------- procedure Print_Header_Box is use Output; begin Write_Line ("----------------------------------------------------"); Write_Line ("-- This file was automaticaly generated by --"); Write_Line ("-- Ocarina with the AADL/Petriscript translator --"); Write_Line ("----------------------------------------------------"); Write_Line (""); end Print_Header_Box; end Ocarina.PN.Printer;