-- EDIF printer. -- Copyright (C) 2019 Tristan Gingold -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 2 of the License, or -- (at your option) any later version. -- -- This program 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 -- along with this program. If not, see . with Ada.Text_IO; use Ada.Text_IO; with Types; use Types; with Str_Table; with Name_Table; package body Edif.Disp_Edif is procedure Disp (N : Node; Indent : Natural); procedure Disp_Int32 (V : Int32) is S : constant String := Int32'Image (V); begin if S (1) = ' ' then Put (S (2 .. S'Last)); else Put (S); end if; end Disp_Int32; procedure Disp_Symbol (S : Name_Id) is Img : constant String := Name_Table.Image (S); begin if Img (Img'First) not in 'a' .. 'z' then Put ('&'); end if; Put (Img); end Disp_Symbol; procedure Disp_Indent (Indent : Natural) is begin Put ((1 .. 2 * Indent => ' ')); end Disp_Indent; procedure Disp_Chain (Chain : Node; Indent : Natural) is N : Node; begin N := Chain; while N /= Null_Node loop Disp (N, Indent); N := Get_Chain (N); end loop; end Disp_Chain; procedure Disp_Keyword_Head (Name : String; Indent : Natural) is begin Disp_Indent (Indent); Put ('('); Put (Name); Put (' '); end Disp_Keyword_Head; procedure Disp_Keyword_Tail is begin Put (')'); New_Line; end Disp_Keyword_Tail; procedure Disp_Keyword (Name : String; Arg : Int32; Indent : Natural) is begin Disp_Keyword_Head (Name, Indent); Disp_Int32 (Arg); Disp_Keyword_Tail; end Disp_Keyword; procedure Disp_Keyword (Name : String; Arg : Node; Indent : Natural) is begin Disp_Keyword_Head (Name, Indent); Disp (Arg, Indent + 1); Disp_Keyword_Tail; end Disp_Keyword; procedure Disp_Keyword (Name : String; Arg : Name_Id; Indent : Natural) is begin Disp_Keyword_Head (Name, Indent); Disp_Symbol (Arg); Disp_Keyword_Tail; end Disp_Keyword; procedure Disp_Decl_Head (Name : String; N : Node; Indent : Natural) is begin Disp_Keyword_Head (Name, Indent); Disp (Get_Name (N), Indent); New_Line; end Disp_Decl_Head; procedure Disp_Decl_Tail (Indent : Natural) is begin Disp_Indent (Indent); Disp_Keyword_Tail; end Disp_Decl_Tail; procedure Disp_Opt (N : Node; Indent : Natural) is begin if N /= Null_Node then Disp (N, Indent); end if; end Disp_Opt; procedure Disp (N : Node; Indent : Natural) is begin if N = Null_Node then Put ("()"); return; end if; case Get_Kind (N) is when N_Keyword => declare El : Node; begin New_Line; Disp_Indent (Indent); Put ('('); Put (Name_Table.Image (Get_Keyword (N))); El := Get_CDR (N); while El /= Null_Node loop Put (' '); Disp (Get_CAR (El), Indent + 1); El := Get_CDR (El); end loop; Put (')'); end; when N_Symbol => Disp_Symbol (Get_Symbol (N)); when N_Number => Disp_Int32 (Get_Number (N)); when N_String => Put ('"'); Put (Str_Table.String_String8 (Get_String_Id (N), Nat32 (Get_String_Len (N)))); Put ('"'); when N_Edif => Disp_Decl_Head ("edif", N, Indent); Disp_Keyword ("edifversion", Get_Edif_Version (N), Indent + 1); Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); Disp_Keyword ("keywordmap", Get_Keyword_Map (N), Indent + 1); Disp_Keyword ("status", Get_Status (N), Indent + 1); Disp_Chain (Get_External_Chain (N), Indent + 1); Disp_Chain (Get_Library_Chain (N), Indent + 1); Disp (Get_Design (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Library => Disp_Decl_Head ("library", N, Indent); Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); Disp_Keyword ("technology", Get_Technology (N), Indent + 1); Disp_Chain (Get_Cells_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_External => Disp_Decl_Head ("external", N, Indent); Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); Disp_Keyword ("technology", Get_Technology (N), Indent + 1); Disp_Chain (Get_Cells_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Cell => Disp_Decl_Head ("cell", N, Indent); Disp_Keyword ("celltype", Get_Cell_Type (N), Indent + 1); Disp (Get_View (N), Indent + 1); Disp_Decl_Tail (Indent); when N_View => Disp_Decl_Head ("view", N, Indent); Disp_Keyword ("viewtype", Get_View_Type (N), Indent + 1); Disp (Get_Interface (N), Indent + 1); declare Contents : constant Node := Get_Contents_Chain (N); begin if Contents /= Null_Node then Disp_Keyword_Head ("contents", Indent + 1); New_Line; Disp_Chain (Contents, Indent + 2); Disp_Indent (Indent + 1); Disp_Keyword_Tail; end if; end; Disp_Decl_Tail (Indent); when N_Interface => Disp_Keyword_Head ("interface", Indent); New_Line; Disp_Chain (Get_Ports_Chain (N), Indent + 1); Disp_Chain (Get_Properties_Chain (N), Indent + 1); Disp_Indent (Indent); Disp_Keyword_Tail; when N_Port => Disp_Decl_Head ("port", N, Indent); Disp_Keyword_Head ("direction", Indent + 1); case Get_Direction (N) is when Dir_Input => Put ("input"); when Dir_Output => Put ("output"); when Dir_Inout => Put ("inout"); end case; Disp_Keyword_Tail; Disp_Decl_Tail (Indent); when N_Rename => Put ("(rename "); Disp (Get_Name (N), Indent); Put (' '); Disp (Get_String (N), Indent); Put (')'); when N_Member => Put ("(member "); Disp (Get_Name (N), Indent); Put (' '); Disp_Int32 (Get_Index (N)); Put (')'); when N_Array => Put ("(array "); Disp (Get_Name (N), Indent); Put (' '); Disp_Int32 (Get_Array_Length (N)); Put (')'); when N_Instance => Disp_Decl_Head ("instance", N, Indent); Disp (Get_Instance_Ref (N), Indent + 1); Disp_Chain (Get_Port_Instances_Chain (N), Indent + 1); Disp_Chain (Get_Properties_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Net => Disp_Decl_Head ("net", N, Indent); Disp_Chain (Get_Joined_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_View_Ref => Disp_Decl_Head ("viewref", N, Indent); Disp (Get_Cell_Ref (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Cell_Ref => Disp_Keyword_Head ("cellref", Indent); Disp (Get_Name (N), Indent); Disp_Opt (Get_Library_Ref (N), Indent + 1); Disp_Keyword_Tail; when N_Port_Ref => Disp_Keyword_Head ("portref", Indent); Disp (Get_Port (N), Indent); Disp_Opt (Get_Instance_Ref (N), Indent + 1); Disp_Keyword_Tail; when N_Property => Disp_Keyword_Head ("property", Indent); Disp (Get_Name (N), Indent); Put (' '); Disp (Get_Value (N), Indent); Disp_Keyword_Tail; when N_Port_Instance => Disp_Decl_Head ("portinstance", N, Indent); Disp_Chain (Get_Properties_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Design => Disp_Decl_Head ("design", N, Indent); Disp (Get_Cell_Ref (N), Indent + 1); Disp_Chain (Get_Properties_Chain (N), Indent + 1); Disp_Decl_Tail (Indent); when N_Boolean => if Get_Boolean (N) then Put ("(true)"); else Put ("(false)"); end if; when others => Put ("??? " & Nkind'Image (Get_Kind (N))); end case; end Disp; procedure Disp_Node (N : Node) is begin Disp (N, 0); end Disp_Node; end Edif.Disp_Edif;