1-- EDIF printer. 2-- Copyright (C) 2019 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Ada.Text_IO; use Ada.Text_IO; 18with Types; use Types; 19with Str_Table; 20with Name_Table; 21 22package body Edif.Disp_Edif is 23 procedure Disp (N : Node; Indent : Natural); 24 25 procedure Disp_Int32 (V : Int32) 26 is 27 S : constant String := Int32'Image (V); 28 begin 29 if S (1) = ' ' then 30 Put (S (2 .. S'Last)); 31 else 32 Put (S); 33 end if; 34 end Disp_Int32; 35 36 procedure Disp_Symbol (S : Name_Id) 37 is 38 Img : constant String := Name_Table.Image (S); 39 begin 40 if Img (Img'First) not in 'a' .. 'z' then 41 Put ('&'); 42 end if; 43 Put (Img); 44 end Disp_Symbol; 45 46 procedure Disp_Indent (Indent : Natural) is 47 begin 48 Put ((1 .. 2 * Indent => ' ')); 49 end Disp_Indent; 50 51 procedure Disp_Chain (Chain : Node; Indent : Natural) 52 is 53 N : Node; 54 begin 55 N := Chain; 56 while N /= Null_Node loop 57 Disp (N, Indent); 58 N := Get_Chain (N); 59 end loop; 60 end Disp_Chain; 61 62 procedure Disp_Keyword_Head (Name : String; Indent : Natural) is 63 begin 64 Disp_Indent (Indent); 65 Put ('('); 66 Put (Name); 67 Put (' '); 68 end Disp_Keyword_Head; 69 70 procedure Disp_Keyword_Tail is 71 begin 72 Put (')'); 73 New_Line; 74 end Disp_Keyword_Tail; 75 76 procedure Disp_Keyword (Name : String; Arg : Int32; Indent : Natural) is 77 begin 78 Disp_Keyword_Head (Name, Indent); 79 Disp_Int32 (Arg); 80 Disp_Keyword_Tail; 81 end Disp_Keyword; 82 83 procedure Disp_Keyword (Name : String; Arg : Node; Indent : Natural) is 84 begin 85 Disp_Keyword_Head (Name, Indent); 86 Disp (Arg, Indent + 1); 87 Disp_Keyword_Tail; 88 end Disp_Keyword; 89 90 procedure Disp_Keyword (Name : String; Arg : Name_Id; Indent : Natural) is 91 begin 92 Disp_Keyword_Head (Name, Indent); 93 Disp_Symbol (Arg); 94 Disp_Keyword_Tail; 95 end Disp_Keyword; 96 97 procedure Disp_Decl_Head (Name : String; N : Node; Indent : Natural) is 98 begin 99 Disp_Keyword_Head (Name, Indent); 100 Disp (Get_Name (N), Indent); 101 New_Line; 102 end Disp_Decl_Head; 103 104 procedure Disp_Decl_Tail (Indent : Natural) is 105 begin 106 Disp_Indent (Indent); 107 Disp_Keyword_Tail; 108 end Disp_Decl_Tail; 109 110 procedure Disp_Opt (N : Node; Indent : Natural) is 111 begin 112 if N /= Null_Node then 113 Disp (N, Indent); 114 end if; 115 end Disp_Opt; 116 117 procedure Disp (N : Node; Indent : Natural) is 118 begin 119 if N = Null_Node then 120 Put ("()"); 121 return; 122 end if; 123 124 case Get_Kind (N) is 125 when N_Keyword => 126 declare 127 El : Node; 128 begin 129 New_Line; 130 Disp_Indent (Indent); 131 Put ('('); 132 Put (Name_Table.Image (Get_Keyword (N))); 133 El := Get_CDR (N); 134 while El /= Null_Node loop 135 Put (' '); 136 Disp (Get_CAR (El), Indent + 1); 137 El := Get_CDR (El); 138 end loop; 139 Put (')'); 140 end; 141 142 when N_Symbol => 143 Disp_Symbol (Get_Symbol (N)); 144 145 when N_Number => 146 Disp_Int32 (Get_Number (N)); 147 148 when N_String => 149 Put ('"'); 150 Put (Str_Table.String_String8 151 (Get_String_Id (N), Nat32 (Get_String_Len (N)))); 152 Put ('"'); 153 154 when N_Edif => 155 Disp_Decl_Head ("edif", N, Indent); 156 Disp_Keyword ("edifversion", Get_Edif_Version (N), Indent + 1); 157 Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); 158 Disp_Keyword ("keywordmap", Get_Keyword_Map (N), Indent + 1); 159 Disp_Keyword ("status", Get_Status (N), Indent + 1); 160 Disp_Chain (Get_External_Chain (N), Indent + 1); 161 Disp_Chain (Get_Library_Chain (N), Indent + 1); 162 Disp (Get_Design (N), Indent + 1); 163 Disp_Decl_Tail (Indent); 164 165 when N_Library => 166 Disp_Decl_Head ("library", N, Indent); 167 Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); 168 Disp_Keyword ("technology", Get_Technology (N), Indent + 1); 169 Disp_Chain (Get_Cells_Chain (N), Indent + 1); 170 Disp_Decl_Tail (Indent); 171 172 when N_External => 173 Disp_Decl_Head ("external", N, Indent); 174 Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); 175 Disp_Keyword ("technology", Get_Technology (N), Indent + 1); 176 Disp_Chain (Get_Cells_Chain (N), Indent + 1); 177 Disp_Decl_Tail (Indent); 178 179 when N_Cell => 180 Disp_Decl_Head ("cell", N, Indent); 181 Disp_Keyword ("celltype", Get_Cell_Type (N), Indent + 1); 182 Disp (Get_View (N), Indent + 1); 183 Disp_Decl_Tail (Indent); 184 185 when N_View => 186 Disp_Decl_Head ("view", N, Indent); 187 Disp_Keyword ("viewtype", Get_View_Type (N), Indent + 1); 188 Disp (Get_Interface (N), Indent + 1); 189 declare 190 Contents : constant Node := Get_Contents_Chain (N); 191 begin 192 if Contents /= Null_Node then 193 Disp_Keyword_Head ("contents", Indent + 1); 194 New_Line; 195 Disp_Chain (Contents, Indent + 2); 196 Disp_Indent (Indent + 1); 197 Disp_Keyword_Tail; 198 end if; 199 end; 200 Disp_Decl_Tail (Indent); 201 202 when N_Interface => 203 Disp_Keyword_Head ("interface", Indent); 204 New_Line; 205 Disp_Chain (Get_Ports_Chain (N), Indent + 1); 206 Disp_Chain (Get_Properties_Chain (N), Indent + 1); 207 Disp_Indent (Indent); 208 Disp_Keyword_Tail; 209 210 when N_Port => 211 Disp_Decl_Head ("port", N, Indent); 212 Disp_Keyword_Head ("direction", Indent + 1); 213 case Get_Direction (N) is 214 when Dir_Input => 215 Put ("input"); 216 when Dir_Output => 217 Put ("output"); 218 when Dir_Inout => 219 Put ("inout"); 220 end case; 221 Disp_Keyword_Tail; 222 Disp_Decl_Tail (Indent); 223 224 when N_Rename => 225 Put ("(rename "); 226 Disp (Get_Name (N), Indent); 227 Put (' '); 228 Disp (Get_String (N), Indent); 229 Put (')'); 230 231 when N_Member => 232 Put ("(member "); 233 Disp (Get_Name (N), Indent); 234 Put (' '); 235 Disp_Int32 (Get_Index (N)); 236 Put (')'); 237 238 when N_Array => 239 Put ("(array "); 240 Disp (Get_Name (N), Indent); 241 Put (' '); 242 Disp_Int32 (Get_Array_Length (N)); 243 Put (')'); 244 245 when N_Instance => 246 Disp_Decl_Head ("instance", N, Indent); 247 Disp (Get_Instance_Ref (N), Indent + 1); 248 Disp_Chain (Get_Port_Instances_Chain (N), Indent + 1); 249 Disp_Chain (Get_Properties_Chain (N), Indent + 1); 250 Disp_Decl_Tail (Indent); 251 252 when N_Net => 253 Disp_Decl_Head ("net", N, Indent); 254 Disp_Chain (Get_Joined_Chain (N), Indent + 1); 255 Disp_Decl_Tail (Indent); 256 257 when N_View_Ref => 258 Disp_Decl_Head ("viewref", N, Indent); 259 Disp (Get_Cell_Ref (N), Indent + 1); 260 Disp_Decl_Tail (Indent); 261 262 when N_Cell_Ref => 263 Disp_Keyword_Head ("cellref", Indent); 264 Disp (Get_Name (N), Indent); 265 Disp_Opt (Get_Library_Ref (N), Indent + 1); 266 Disp_Keyword_Tail; 267 268 when N_Port_Ref => 269 Disp_Keyword_Head ("portref", Indent); 270 Disp (Get_Port (N), Indent); 271 Disp_Opt (Get_Instance_Ref (N), Indent + 1); 272 Disp_Keyword_Tail; 273 274 when N_Property => 275 Disp_Keyword_Head ("property", Indent); 276 Disp (Get_Name (N), Indent); 277 Put (' '); 278 Disp (Get_Value (N), Indent); 279 Disp_Keyword_Tail; 280 281 when N_Port_Instance => 282 Disp_Decl_Head ("portinstance", N, Indent); 283 Disp_Chain (Get_Properties_Chain (N), Indent + 1); 284 Disp_Decl_Tail (Indent); 285 286 when N_Design => 287 Disp_Decl_Head ("design", N, Indent); 288 Disp (Get_Cell_Ref (N), Indent + 1); 289 Disp_Chain (Get_Properties_Chain (N), Indent + 1); 290 Disp_Decl_Tail (Indent); 291 292 when N_Boolean => 293 if Get_Boolean (N) then 294 Put ("(true)"); 295 else 296 Put ("(false)"); 297 end if; 298 299 when others => 300 Put ("??? " & Nkind'Image (Get_Kind (N))); 301 end case; 302 end Disp; 303 304 procedure Disp_Node (N : Node) is 305 begin 306 Disp (N, 0); 307 end Disp_Node; 308end Edif.Disp_Edif; 309