------------------------------------------------------ -------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- G A I 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 Gaia.Pn.Nodes; with Gaia.Pn.Nutils; with Gaia.Utils; with Gaia.Messages; with Ocarina.AADL_Values; package body Gaia.Pn.Printer is package GPN renames Gaia.Pn.Nodes; package GPNU renames Gaia.Pn.Nutils; package OAV renames Ocarina.AADL_Values; use Output; use Types; use Namet; use GPN; use GPNU; use Gaia.Messages; ------------------ -- I/O Routines -- ------------------ procedure W_Line (S : String); -- Write_Line procedure W_Str (S : String); -- Write_Str procedure W_Indent (Offset : Integer := 0); -- Write_Indentation At_Bol : Boolean := True; -- Write the indentation only if we are at the beginning of a line ---------------------- -- Printer Routines -- ---------------------- Model_Desc : GNAT.OS_Lib.File_Descriptor; MetaScribe_Model_Printed : Boolean := False; procedure Print_Container (Box : Node_Id); procedure Print_Fonctionnal_Entity (Box : Node_Id); procedure Print_Subcomponents (Box : Node_Id); procedure Print_Place_Declaration (Place : Node_Id); procedure Print_Transition_Declaration (Transition : Node_Id); procedure Print_Guard (T : Node_Id); procedure Print_Domain (D : List_Id); procedure Print_Markings (Place : Node_Id); procedure Print_Position (Position : Node_Id); procedure Print_Arc_Color (A : Node_Id); procedure Print_Include (Call : Node_Id); procedure Print_Connection_Statement (Connect : Node_Id); procedure Print_Place_Fusion (Fusion : Node_Id); procedure Print_PN_Color_Declarations (Root : Node_Id); procedure Print_Header_Box; function Get_Full_Name (Node : Node_Id) return String; function Get_Scoped_Name (Node : Node_Id) return String; function Get_Scoped_Name_Rec (Node : Node_Id) return String; ------------ -- W_Line -- ------------ procedure W_Line (S : String) is begin W_Indent; Write_Line (S); At_Bol := True; end W_Line; ----------- -- W_Str -- ----------- procedure W_Str (S : String) is begin W_Indent; Write_Str (S); end W_Str; -------------- -- W_Indent -- -------------- procedure W_Indent (Offset : Integer := 0) is begin if At_Bol then Write_Indentation (Offset); At_Bol := False; end if; end W_Indent; ------------------------- -- Get_Scoped_Name_Rec -- ------------------------- function Get_Scoped_Name_Rec (Node : Node_Id) return String is Parent : Node_Id; begin Parent := GPN.Parent_Scoped_Name (Node); if Parent = No_Node then if GPN.Name (GPN.Identifier (Node)) = No_Name then return ""; end if; return (Get_Name_String (GPN.Name (GPN.Identifier (Node))) & "_"); else if GPN.Name (GPN.Identifier (Node)) = No_Name then return Get_Scoped_Name_Rec (Parent); end if; return (Get_Scoped_Name_Rec (Parent) & Get_Name_String (GPN.Name (GPN.Identifier (Node))) & "_"); end if; end Get_Scoped_Name_Rec; --------------------- -- Get_Scoped_Name -- --------------------- function Get_Scoped_Name (Node : Node_Id) return String is Parent : Node_Id; begin Parent := GPN.Parent_Scoped_Name (Node); if Parent = No_Node then if GPN.Name (GPN.Identifier (Node)) = No_Name then return ""; end if; return Get_Name_String (GPN.Name (GPN.Identifier (Node))); else if GPN.Name (GPN.Identifier (Node)) = No_Name then return Get_Scoped_Name (Parent); end if; return (Get_Scoped_Name_Rec (Parent) & Get_Name_String (GPN.Name (GPN.Identifier (Node)))); end if; end Get_Scoped_Name; ------------------- -- Get_Full_Name -- ------------------- function Get_Full_Name (Node : Node_Id) return String is Parent : Node_Id; begin Parent := GPN.Parent_Scoped_Name (GPN.Scoped_Name (Node)); if Parent /= No_Node then if GPN.Name (GPN.Identifier (Node)) /= No_Name then return (Get_Scoped_Name_Rec (Parent) & Get_Name_String (GPN.Name (GPN.Identifier (Node)))); else return Get_Scoped_Name (Parent); end if; else return Get_Name_String (GPN.Name (GPN.Identifier (Scoped_Name (Node)))); end if; end Get_Full_Name; ---------------------------------- -- Print_Transition_Declaration -- ---------------------------------- procedure Print_Transition_Declaration (Transition : Node_Id) is use OAV; pragma Assert (Transition /= No_Node and then GPN.Kind (Transition) = GPN.K_Transition_Declaration); begin W_Str ("create transition "); W_Str ("""" & Get_Full_Name (Transition) & """"); W_Str (" ("); Print_Position (Position (Transition)); Print_Guard (Transition); W_Line (");"); end Print_Transition_Declaration; ----------------------------- -- Print_Place_Declaration -- ----------------------------- procedure Print_Place_Declaration (Place : Node_Id) is use OAV; pragma Assert (Place /= No_Node and then GPN.Kind (Place) = GPN.K_Place_Declaration); begin W_Str ("create place "); W_Str ("""" & Get_Full_Name (Place) & """"); W_Str (" ("); Print_Domain (Domains (Place)); W_Str (", "); Print_Position (Position (Place)); Print_Markings (Place); W_Line (");"); end Print_Place_Declaration; ----------------- -- Print_Guard -- ----------------- procedure Print_Guard (T : Node_Id) is pragma Assert (GPN.Kind (T) = GPN.K_Transition_Declaration); use OAV; G : Node_Id; begin G := Guard (T); if G /= No_Node then W_Str (", guard ""["); W_Str (Get_Full_Name (Variable (G))); W_Str (" " & Image (Operator (G), False) & " "); W_Str (Get_Full_Name (Color (G))); W_Str ("." & Image (Value (G), False) & "]"""); end if; end Print_Guard; ------------------ -- Print_Domain -- ------------------ procedure Print_Domain (D : List_Id) is L : Node_Id; begin L := First_Node (D); W_Str ("domain ""<"); while L /= No_Node loop W_Str (Get_Full_Name (Refered_Node (L))); L := Next_Node (L); if L /= No_Node then W_Str (", "); end if; end loop; W_Str (">"""); end Print_Domain; -------------------- -- Print_Position -- -------------------- procedure Print_Position (Position : Node_Id) is use OAV; begin W_Str ("x " & OAV.Image (Y_Value (Position)) & ", y " & OAV.Image (X_Value (Position))); end Print_Position; -------------------- -- Print_Markings -- -------------------- procedure Print_Markings (Place : Node_Id) is use OAV; pragma Assert (Place /= No_Node and then GPN.Kind (Place) = GPN.K_Place_Declaration); L : Node_Id; begin if not Is_Empty (GPN.Tokens (Place)) then W_Str (", marking """); L := First_Node (Tokens (Place)); while L /= No_Node loop W_Str ("<" & Get_Full_Name (Color (L)) & "." & OAV.Image (Value (L), False) & ">"); L := Next_Node (L); if L /= No_Node then W_Str (", "); end if; end loop; W_Str (""""); end if; end Print_Markings; -------------------------------- -- Print_Connection_Statement -- -------------------------------- procedure Print_Connection_Statement (Connect : Node_Id) is pragma Assert (Connect /= No_Node and then GPN.Kind (Connect) = GPN.K_Connect_Statement); begin W_Str ("connect "); Print_Arc_Color (Connect); if GPN.Is_Link_Place_To_Transition (Connect) then W_Str ("place "); W_Str ("""" & Get_Full_Name (GPN.First_Reference (Connect)) & """"); W_Str (" to transition "); W_Str ("""" & Get_Full_Name (GPN.Second_Reference (Connect)) & """"); W_Line (";"); else W_Str ("transition "); W_Str ("""" & Get_Full_Name (GPN.First_Reference (Connect)) & """"); W_Str (" to place "); W_Str ("""" & Get_Full_Name (GPN.Second_Reference (Connect)) & """"); W_Line (";"); end if; end Print_Connection_Statement; --------------------- -- 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 W_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 W_Str (OAV.Image (Number (Refered_Node (N))) & "*"); end if; W_Str ("<"); W_Str (Get_Full_Name (V) & ">"); if Next_Node (N) /= No_Node then W_Str ("+"); end if; else W_Str ("<"); W_Str (Get_Full_Name (Color (Refered_Node (N))) & "."); W_Str (OAV.Image (Value (Refered_Node (N)), False) & ">"); if Next_Node (N) /= No_Node then W_Str ("+"); end if; end if; N := Next_Node (N); end loop; W_Str (""" "); end if; end Print_Arc_Color; ------------------- -- Print_Include -- ------------------- procedure Print_Include (Call : Node_Id) is pragma Assert (Call /= No_Node and then GPN.Kind (Call) = GPN.K_Include_Call); begin W_Str ("#include "); W_Str (Get_Scoped_Name (Namespace_Scoped_Name (Call)) & " "); W_Line (Get_Scoped_Name (Subprogram_Scoped_Name (Call))); end Print_Include; ------------------------ -- Print_Place_Fusion -- ------------------------ procedure Print_Place_Fusion (Fusion : Node_Id) is pragma Assert (Fusion /= No_Node and then GPN.Kind (Fusion) = GPN.K_Place_Fusion); begin W_Str ("merge place "); W_Str ("""" & Get_Full_Name (GPN.First_Reference (Fusion)) & """"); W_Str (" and place "); W_Str ("""" & Get_Full_Name (GPN.Second_Reference (Fusion)) & """"); if GPN.New_Scoped_Name (Fusion) /= No_Node then W_Str (" into name "); if Full_Naming_Policy then W_Str ("""" & Get_Scoped_Name (GPN.New_Scoped_Name (Fusion)) & """"); else W_Str ("""" & Get_Scoped_Name (GPN.New_Scoped_Name (Fusion)) & "_m"""); end if; end if; W_Line (";"); end Print_Place_Fusion; ------------------------- -- Print_Subcomponents -- ------------------------- procedure Print_Subcomponents (Box : Node_Id) is use OAV; begin case GPN.Kind (Box) is when GPN.K_Container => W_Line (""); W_Line ("-- " & Get_Full_Name (Box)); Print_Container (Box); when GPN.K_Fonctionnal_Entity => W_Line (""); W_Line ("-- " & Get_Full_Name (Box)); Print_Fonctionnal_Entity (Box); when GPN.K_Thread_Box => W_Line (""); W_Str ("-- thread " & Get_Full_Name (Box) & " "); W_Line ("(th_" & Image (Integer (Box)) & ")"); W_Line (""); Print_Fonctionnal_Entity (Box); when others => raise Program_Error; end case; end Print_Subcomponents; ------------------------------ -- Print_Fonctionnal_Entity -- ------------------------------ procedure Print_Fonctionnal_Entity (Box : Node_Id) is pragma Assert (Box /= No_Node and then (GPN.Kind (Box) = K_Fonctionnal_Entity or else GPN.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 GPNU.Is_Empty (GPN.Places (Box)) then A_Node := GPN.First_Node (GPN.Places (Box)); while A_Node /= No_Node loop Print_Place_Declaration (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- We create the local transitions if not GPNU.Is_Empty (GPN.Transitions (Box)) then A_Node := GPN.First_Node (GPN.Transitions (Box)); while A_Node /= No_Node loop Print_Transition_Declaration (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- TODO : -- Create loop declaration here -- Process subcomponents if not GPNU.Is_Empty (GPN.Sub_Components (Box)) then A_Node := GPN.First_Node (GPN.Sub_Components (Box)); while A_Node /= No_Node loop Print_Subcomponents (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- We create the local connections if not GPNU.Is_Empty (GPN.Connections (Box)) then A_Node := GPN.First_Node (GPN.Connections (Box)); while A_Node /= No_Node loop Print_Connection_Statement (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- Declare fusions if not Is_Empty (Places_Fusions (Box)) then A_Node := GPN.First_Node (GPN.Places_Fusions (Box)); while Present (A_Node) loop Print_Place_Fusion (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; end Print_Fonctionnal_Entity; --------------------- -- Print_Container -- --------------------- procedure Print_Container (Box : Node_Id) is pragma Assert (Box /= No_Node and then GPN.Kind (Box) = GPN.K_Container); A_Node : Node_Id; begin -- We create the local places if not GPNU.Is_Empty (GPN.Places (Box)) then A_Node := First_Node (GPN.Places (Box)); while Present (A_Node) loop Print_Place_Declaration (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- We create the local transitions if not GPNU.Is_Empty (GPN.Transitions (Box)) then A_Node := First_Node (GPN.Transitions (Box)); while Present (A_Node) loop Print_Transition_Declaration (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- TODO : -- Create loop declaration here -- Process subcomponents if not GPNU.Is_Empty (GPN.Sub_Components (Box)) then A_Node := GPN.First_Node (GPN.Sub_Components (Box)); while Present (A_Node) loop Print_Subcomponents (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- We create the local connections if not GPNU.Is_Empty (GPN.Connections (Box)) then A_Node := GPN.First_Node (GPN.Connections (Box)); while Present (A_Node) loop Print_Connection_Statement (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; -- Declare fusions if not GPNU.Is_Empty (Places_Fusions (Box)) then A_Node := GPN.First_Node (GPN.Places_Fusions (Box)); while Present (A_Node) loop Print_Place_Fusion (A_Node); A_Node := GPN.Next_Node (A_Node); end loop; end if; end Print_Container; --------------------- -- Print_Root_Node -- --------------------- procedure Print_Root_Node (Root : Types.Node_Id; Options : Gaia.Mgmt.Gaia_Options) is use Gaia.Utils; use Gaia.Mgmt; use GNAT.OS_Lib; pragma Unreferenced (Options); pragma Assert (Root /= No_Node and then GPN.Kind (Root) = GPN.K_Root_Node); Directory : Name_Id; Root_Node : Node_Id; begin if not MetaScribe_Model_Printed then MetaScribe_Model_Printed := True; Directory := GPN.Directory_Name (Root); Create_Directory (Directory); -- Open the file we will write Enter_Directory (Directory); Model_Desc := Create_File ("partition.psc", Binary); if Model_Desc = Invalid_FD then Display_Error ("Could not create the 'partition.psc' file ", Fatal => True); end if; Set_Output (Model_Desc); -- Print Headers Print_Header_Box; Print_PN_Color_Declarations (Root); -- Process the application nodes Root_Node := GPN.First_Node (GPN.Sub_Components (Root)); while Present (Root_Node) loop Print_Container (Root_Node); Root_Node := GPN.Next_Node (Root_Node); end loop; -- We create the high-level nodes if not GPNU.Is_Empty (GPN.Transitions (Root)) then Root_Node := GPN.First_Node (GPN.Transitions (Root)); while Present (Root_Node) loop Print_Transition_Declaration (Root_Node); Root_Node := GPN.Next_Node (Root_Node); end loop; end if; if not GPNU.Is_Empty (GPN.Places (Root)) then Root_Node := GPN.First_Node (GPN.Places (Root)); while Present (Root_Node) loop Print_Place_Declaration (Root_Node); Root_Node := GPN.Next_Node (Root_Node); end loop; end if; -- We create the high-level connections if not GPNU.Is_Empty (GPN.Connections (Root)) then Root_Node := GPN.First_Node (GPN.Connections (Root)); while Present (Root_Node) loop Print_Connection_Statement (Root_Node); Root_Node := GPN.Next_Node (Root_Node); end loop; end if; -- Close the file we wrote Set_Standard_Output; Close (Model_Desc); Leave_Directory; end if; end Print_Root_Node; --------------------------------- -- Print_PN_Color_Declarations -- --------------------------------- procedure Print_PN_Color_Declarations (Root : Node_Id) is use OAV; N : Node_Id; V : Node_Id; begin -- Make_Control_Color; W_Str ("set net to declaration """); -- All data flows if not Is_Empty (Color_Declarations (Root)) then N := GPN.First_Node (Color_Declarations (Root)); while Present (N) loop W_Str ("Class "); W_Str (Get_Full_Name (N)); W_Str (" is [" & Image (Valid_Color_Obj, False) & ", " & Image (Invalid_Color_Obj, False)); -- We add special values if not Is_Empty (Symbolic_Values (N)) then V := First_Node (Symbolic_Values (N)); while V /= No_Node loop W_Str (", " & Image (Value_Name (V), False)); V := Next_Node (V); end loop; end if; W_Str ("]; / var "); W_Str (Get_Full_Name (Color_Variable (N))); W_Str (" in "); W_Str (Get_Full_Name (N)); W_Line (";"); N := GPN.Next_Node (N); end loop; end if; W_Str ("Class "); W_Str (Get_Full_Name (Control_Color)); W_Str (" is [" & OAV.Image (Valid_Color_Obj, False) & ", " & OAV.Image (Invalid_Color_Obj, False)); -- We add threads values if not Is_Empty (Symbolic_Values (Control_Color)) then V := First_Node (Symbolic_Values (Control_Color)); while V /= No_Node loop W_Str (", " & Image (Value_Name (V), False)); V := Next_Node (V); end loop; end if; W_Str ("]; / var "); W_Str (Get_Full_Name (Color_Variable (Control_Color))); W_Str (" in "); W_Str (Get_Full_Name (Control_Color)); W_Line (";"";"); end Print_PN_Color_Declarations; ---------------------- -- Print_Header_Box -- ---------------------- procedure Print_Header_Box is begin W_Line ("----------------------------------------------------"); W_Line ("-- This file was automaticaly generated by --"); W_Line ("-- Ocarina with the AADL/Petriscript translator --"); W_Line ("----------------------------------------------------"); W_Line (""); end Print_Header_Box; begin Space_Increment := 3; -- We increment indentation by 3 spaces end Gaia.Pn.Printer;