1-- Disp a netlist in vhdl using the original entity. 2-- Copyright (C) 2019 Tristan Gingold 3-- 4-- This file is part of GHDL. 5-- 6-- This program is free software; you can redistribute it and/or modify 7-- it under the terms of the GNU General Public License as published by 8-- the Free Software Foundation; either version 2 of the License, or 9-- (at your option) any later version. 10-- 11-- This program is distributed in the hope that it will be useful, 12-- but WITHOUT ANY WARRANTY; without even the implied warranty of 13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14-- GNU General Public License for more details. 15-- 16-- You should have received a copy of the GNU General Public License 17-- along with this program; if not, write to the Free Software 18-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, 19-- MA 02110-1301, USA. 20 21with Simple_IO; use Simple_IO; 22with Utils_IO; use Utils_IO; 23with Types; use Types; 24with Name_Table; 25 26with Vhdl.Prints; 27with Vhdl.Std_Package; 28with Vhdl.Ieee.Std_Logic_1164; 29with Vhdl.Errors; use Vhdl.Errors; 30with Vhdl.Utils; use Vhdl.Utils; 31 32with Netlists.Iterators; use Netlists.Iterators; 33with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl; 34 35with Synth.Objtypes; use Synth.Objtypes; 36 37package body Synth.Disp_Vhdl is 38 procedure Disp_Signal (Desc : Port_Desc) is 39 begin 40 if Desc.W > 1 then 41 Put (" subtype typ"); 42 Put_Name (Desc.Name); 43 Put (" is "); 44 Put_Type (Desc.W); 45 Put_Line (";"); 46 end if; 47 Put (" signal "); 48 Put_Name (Desc.Name); 49 Put (": "); 50 if Desc.W > 1 then 51 Put ("typ"); 52 Put_Name (Desc.Name); 53 else 54 Put_Type (Desc.W); 55 end if; 56 Put_Line (";"); 57 end Disp_Signal; 58 59 procedure Disp_Ports_As_Signals (M : Module) 60 is 61 Desc : Port_Desc; 62 begin 63 for I in 1 .. Get_Nbr_Inputs (M) loop 64 Disp_Signal (Get_Input_Desc (M, I - 1)); 65 end loop; 66 for I in 1 .. Get_Nbr_Outputs (M) loop 67 Desc := Get_Output_Desc (M, I - 1); 68 if not Desc.Is_Inout then 69 -- inout ports are not prefixed, so they must not be declared 70 -- as signals. 71 Disp_Signal (Desc); 72 end if; 73 end loop; 74 end Disp_Ports_As_Signals; 75 76 procedure Disp_Pfx (Off : Uns32; W : Width; Full : Boolean) is 77 begin 78 if Full then 79 return; 80 end if; 81 Put (" ("); 82 if W > 1 then 83 Put_Uns32 (Off + W - 1); 84 Put (" downto "); 85 end if; 86 Put_Uns32 (Off); 87 Put (')'); 88 end Disp_Pfx; 89 90 procedure Disp_In_Lhs 91 (Mname : String; Off : Uns32; W : Width; Full : Boolean) is 92 begin 93 Put (" wrap_" & Mname); 94 Disp_Pfx (Off, W, Full); 95 Put (" <= "); 96 end Disp_In_Lhs; 97 98 function Is_Std_Logic_Array (Btype : Node) return Boolean is 99 begin 100 return Is_One_Dimensional_Array_Type (Btype) 101 and then (Get_Base_Type (Get_Element_Subtype (Btype)) 102 = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type); 103 end Is_Std_Logic_Array; 104 105 procedure Disp_In_Converter (Mname : String; 106 Pfx : String; 107 Off : Uns32; 108 Ptype : Node; 109 Typ : Type_Acc; 110 Full : Boolean) 111 is 112 Btype : constant Node := Get_Base_Type (Ptype); 113 W : Width; 114 begin 115 case Get_Kind (Btype) is 116 when Iir_Kind_Enumeration_Type_Definition => 117 if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then 118 -- Nothing to do. 119 Disp_In_Lhs (Mname, Off, 1, Full); 120 Put_Line (Pfx & ";"); 121 else 122 -- Any other enum. 123 W := Typ.W; 124 Disp_In_Lhs (Mname, Off, W, Full); 125 if W = 1 then 126 Put ("'0' when "); 127 else 128 Put ("std_logic_vector(to_unsigned("); 129 end if; 130 Put (Name_Table.Image (Get_Identifier 131 (Get_Type_Declarator (Ptype)))); 132 Put ("'pos (" & Pfx & ")"); 133 if W = 1 then 134 Put (" = 0 else '1';"); 135 else 136 Put ("," & Width'Image (W) & "));"); 137 end if; 138 New_Line; 139 end if; 140 when Iir_Kind_Integer_Type_Definition => 141 -- FIXME: signed or unsigned ? 142 W := Typ.W; 143 Disp_In_Lhs (Mname, Off, W, Full); 144 if W > 1 then 145 Put ("std_logic_vector("); 146 end if; 147 if Typ.Drange.Is_Signed then 148 Put ("to_signed("); 149 else 150 Put ("to_unsigned("); 151 end if; 152 Put (Pfx & "," & Width'Image (W) & ")"); 153 if W > 1 then 154 Put (")"); 155 elsif W = 1 then 156 Put ("(0)"); 157 end if; 158 Put_Line (";"); 159 when Iir_Kind_Array_Type_Definition => 160 if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then 161 -- Nothing to do. 162 W := Typ.Vbound.Len; 163 Disp_In_Lhs (Mname, Off, W, Full); 164 Put (Pfx); 165 if W = 1 then 166 -- This is an array of length 1. A scalar is used in the 167 -- netlist. 168 Put (" (" & Pfx & "'left)"); 169 end if; 170 Put_Line (";"); 171 elsif Is_Std_Logic_Array (Btype) then 172 W := Typ.Vbound.Len; 173 Disp_In_Lhs (Mname, Off, W, Full); 174 if W > 1 then 175 if Full then 176 Put ("typwrap_"); 177 Put (Mname); 178 else 179 Put ("std_logic_vector"); 180 end if; 181 Put ("("); 182 end if; 183 Put (Pfx); 184 if W = 1 then 185 -- This is an array of length 1. A scalar is used in the 186 -- netlist. 187 Put (" (" & Pfx & "'left)"); 188 end if; 189 if W > 1 then 190 Put (')'); 191 end if; 192 Put_Line (";"); 193 elsif Btype = Vhdl.Std_Package.Bit_Vector_Type_Definition then 194 W := Typ.Vbound.Len; 195 Disp_In_Lhs (Mname, Off, W, Full); 196 Put ("to_stdlogicvector (" & Pfx & ")"); 197 Put_Line (";"); 198 else 199 -- Any array. 200 declare 201 Bnd : Bound_Type renames Typ.Abounds.D (1); 202 El_Type : constant Node := Get_Element_Subtype (Ptype); 203 El_W : constant Width := Get_Type_Width (Typ.Arr_El); 204 Idx : Int32; 205 begin 206 for I in 0 .. Bnd.Len - 1 loop 207 case Bnd.Dir is 208 when Dir_To => 209 Idx := Bnd.Left + Int32 (I); 210 when Dir_Downto => 211 Idx := Bnd.Left - Int32 (I); 212 end case; 213 Disp_In_Converter 214 (Mname, 215 Pfx & " (" & Int32'Image (Idx) & ")", 216 Off + I * El_W, El_Type, Typ.Arr_El, False); 217 end loop; 218 end; 219 end if; 220 when Iir_Kind_Record_Type_Definition => 221 declare 222 Els : constant Node_Flist := 223 Get_Elements_Declaration_List (Ptype); 224 Rec_Full : constant Boolean := Full and Typ.W = 1; 225 begin 226 for I in Flist_First .. Flist_Last (Els) loop 227 declare 228 El : constant Node := Get_Nth_Element (Els, I); 229 Et : Rec_El_Type renames 230 Typ.Rec.E (Iir_Index32 (I + 1)); 231 begin 232 Disp_In_Converter 233 (Mname, 234 Pfx & '.' & Name_Table.Image (Get_Identifier (El)), 235 Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); 236 end; 237 end loop; 238 end; 239 when others => 240 Error_Kind ("disp_in_converter", Ptype); 241 end case; 242 end Disp_In_Converter; 243 244 -- Disp conversion for output port (so in the form wrap_i <= i). 245 procedure Disp_Input_Port_Converter (Inst : Synth_Instance_Acc; 246 Port : Node) 247 is 248 Port_Name : constant String := 249 Name_Table.Image (Get_Identifier (Port)); 250 Port_Type : constant Node := Get_Type (Port); 251 Typ : constant Type_Acc := Get_Subtype_Object (Inst, Port_Type); 252 begin 253 Disp_In_Converter (Port_Name, Port_Name, 0, Port_Type, Typ, True); 254 end Disp_Input_Port_Converter; 255 256 procedure Disp_Out_Rhs 257 (Mname : String; Off : Uns32; W : Width; Full : Boolean) is 258 begin 259 Put ("wrap_" & Mname); 260 Disp_Pfx (Off, W, Full); 261 end Disp_Out_Rhs; 262 263 -- PTYPE is the type of the original port, while TYP is the type of 264 -- the netlist port. 265 procedure Disp_Out_Converter (Mname : String; 266 Pfx : String; 267 Off : Uns32; 268 Ptype : Node; 269 Typ : Type_Acc; 270 Full : Boolean) 271 is 272 Btype : constant Node := Get_Base_Type (Ptype); 273 W : Width; 274 begin 275 case Get_Kind (Btype) is 276 when Iir_Kind_Enumeration_Type_Definition => 277 Put (" " & Pfx & " <= "); 278 if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then 279 -- Nothing to do. 280 Disp_Out_Rhs (Mname, Off, 1, Full); 281 Put_Line (";"); 282 elsif Btype = Vhdl.Std_Package.Boolean_Type_Definition then 283 Disp_Out_Rhs (Mname, Off, 1, Full); 284 Put_Line (" = '1';"); 285 elsif Btype = Vhdl.Std_Package.Bit_Type_Definition then 286 Put ("to_bit ("); 287 Disp_Out_Rhs (Mname, Off, 1, Full); 288 Put_Line (");"); 289 else 290 -- Any other enum. 291 W := Typ.W; 292 Put (Name_Table.Image (Get_Identifier 293 (Get_Type_Declarator (Ptype)))); 294 Put ("'val (to_integer(unsigned"); 295 if W = 1 then 296 Put ("'(0 => "); 297 else 298 Put ('('); 299 end if; 300 Disp_Out_Rhs (Mname, Off, W, Full); 301 Put_Line (")));"); 302 end if; 303 when Iir_Kind_Integer_Type_Definition => 304 -- FIXME: signed or unsigned ? 305 W := Typ.W; 306 Put (" " & Pfx & " <= to_integer ("); 307 if Typ.Drange.Is_Signed then 308 Put ("signed"); 309 else 310 Put ("unsigned"); 311 end if; 312 if W = 1 then 313 Put ("'(0 => "); 314 else 315 Put (" ("); 316 end if; 317 Disp_Out_Rhs (Mname, Off, W, Full); 318 Put_Line ("));"); 319 when Iir_Kind_Array_Type_Definition => 320 if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then 321 -- Nothing to do. 322 W := Typ.Vbound.Len; 323 Put (" " & Pfx); 324 if W = 1 then 325 Put (" (" & Pfx & "'left)"); 326 end if; 327 Put (" <= "); 328 Disp_Out_Rhs (Mname, Off, W, Full); 329 Put_Line (";"); 330 elsif Btype = Vhdl.Std_Package.Bit_Vector_Type_Definition then 331 -- Nothing to do. 332 W := Typ.Vbound.Len; 333 Put (" " & Pfx & " <= "); 334 if W = 1 then 335 -- This is an array of length 1. A scalar is used in the 336 -- netlist. 337 Put ("(0 => to_bit ("); 338 else 339 Put ("to_bitvector ("); 340 end if; 341 Disp_Out_Rhs (Mname, Off, W, Full); 342 if W = 1 then 343 Put (')'); 344 end if; 345 Put_Line (");"); 346 elsif Is_Std_Logic_Array (Btype) then 347 -- unsigned, signed or a compatible array. 348 W := Typ.Vbound.Len; 349 Put (" " & Pfx & " <= "); 350 Put (Name_Table.Image (Get_Identifier 351 (Get_Type_Declarator (Btype)))); 352 Put ("("); 353 Disp_Out_Rhs (Mname, Off, W, Full); 354 Put_Line (");"); 355 else 356 declare 357 Bnd : Bound_Type renames Typ.Abounds.D (1); 358 El_Type : constant Node := Get_Element_Subtype (Ptype); 359 El_W : constant Width := Get_Type_Width (Typ.Arr_El); 360 Idx : Int32; 361 begin 362 for I in 0 .. Bnd.Len - 1 loop 363 case Bnd.Dir is 364 when Dir_To => 365 Idx := Bnd.Left + Int32 (I); 366 when Dir_Downto => 367 Idx := Bnd.Left - Int32 (I); 368 end case; 369 Disp_Out_Converter 370 (Mname, 371 Pfx & " (" & Int32'Image (Idx) & ")", 372 Off + I * El_W, El_Type, Typ.Arr_El, False); 373 end loop; 374 end; 375 end if; 376 when Iir_Kind_Record_Type_Definition => 377 declare 378 Els : constant Node_Flist := 379 Get_Elements_Declaration_List (Ptype); 380 Rec_Full : constant Boolean := Full and Typ.W = 1; 381 begin 382 for I in Flist_First .. Flist_Last (Els) loop 383 declare 384 El : constant Node := Get_Nth_Element (Els, I); 385 Et : Rec_El_Type renames 386 Typ.Rec.E (Iir_Index32 (I + 1)); 387 begin 388 Disp_Out_Converter 389 (Mname, 390 Pfx & '.' & Name_Table.Image (Get_Identifier (El)), 391 Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); 392 end; 393 end loop; 394 end; 395 when others => 396 Error_Kind ("disp_out_converter", Ptype); 397 end case; 398 end Disp_Out_Converter; 399 400 -- Disp conversion for output port (so in the form o <= wrap_o). 401 procedure Disp_Output_Port_Converter (Inst : Synth_Instance_Acc; 402 Port : Node) 403 is 404 Port_Name : constant String := 405 Name_Table.Image (Get_Identifier (Port)); 406 Port_Type : constant Node := Get_Type (Port); 407 Typ : constant Type_Acc := Get_Subtype_Object (Inst, Port_Type); 408 begin 409 Disp_Out_Converter (Port_Name, Port_Name, 0, Port_Type, Typ, True); 410 end Disp_Output_Port_Converter; 411 412 procedure Disp_Vhdl_Wrapper 413 (Ent : Node; Top : Module; Inst : Synth_Instance_Acc) 414 is 415 Unit : constant Node := Get_Design_Unit (Ent); 416 Main : Module; 417 Name_Wrap : Name_Id; 418 begin 419 -- Extract the first user submodule. 420 Main := Get_First_Sub_Module (Top); 421 while Get_Id (Main) < Id_User_None loop 422 Main := Get_Next_Sub_Module (Main); 423 end loop; 424 425 -- Disp the original design unit. 426 Vhdl.Prints.Disp_Vhdl (Unit); 427 428 -- Disp sub-units (in reverse order). 429 declare 430 M : Module; 431 Num : Natural; 432 begin 433 Num := 0; 434 M := Get_Next_Sub_Module (Main); 435 while M /= No_Module loop 436 if Get_Id (M) >= Id_User_None then 437 Num := Num + 1; 438 end if; 439 M := Get_Next_Sub_Module (M); 440 end loop; 441 442 declare 443 type Module_Array is array (1 .. Num) of Module; 444 Modules : Module_Array; 445 begin 446 Num := 0; 447 M := Get_Next_Sub_Module (Main); 448 while M /= No_Module loop 449 if Get_Id (M) >= Id_User_None then 450 Num := Num + 1; 451 Modules (Num) := M; 452 end if; 453 M := Get_Next_Sub_Module (M); 454 end loop; 455 456 for I in reverse Modules'Range loop 457 Netlists.Disp_Vhdl.Disp_Vhdl (Modules (I), False); 458 end loop; 459 end; 460 end; 461 New_Line; 462 463 -- Rename ports. 464 Name_Wrap := Name_Table.Get_Identifier ("wrap"); 465 for P of Ports_Desc (Main) loop 466 pragma Assert (Get_Sname_Prefix (P.Name) = No_Sname); 467 if not P.Is_Inout then 468 Set_Sname_Prefix (P.Name, New_Sname_User (Name_Wrap, No_Sname)); 469 end if; 470 end loop; 471 472 Put_Line ("library ieee;"); 473 Put_Line ("use ieee.std_logic_1164.all;"); 474 Put_Line ("use ieee.numeric_std.all;"); 475 New_Line; 476 Put ("architecture rtl of "); 477 Put (Name_Table.Image (Get_Identifier (Ent))); 478 Put_Line (" is"); 479 Disp_Ports_As_Signals (Main); 480 Disp_Architecture_Declarations (Main); 481 Disp_Architecture_Attributes (Main); 482 483 Put_Line ("begin"); 484 if Inst /= null then 485 -- TODO: add assert for the value of the generics. 486 null; 487 end if; 488 489 declare 490 Port : Node; 491 begin 492 Port := Get_Port_Chain (Ent); 493 while Port /= Null_Node loop 494 if Get_Mode (Port) = Iir_In_Mode then 495 Disp_Input_Port_Converter (Inst, Port); 496 end if; 497 Port := Get_Chain (Port); 498 end loop; 499 500 Port := Get_Port_Chain (Ent); 501 while Port /= Null_Node loop 502 if Get_Mode (Port) = Iir_Out_Mode then 503 Disp_Output_Port_Converter (Inst, Port); 504 end if; 505 Port := Get_Chain (Port); 506 end loop; 507 end; 508 509 Disp_Architecture_Statements (Main); 510 Put_Line ("end rtl;"); 511 end Disp_Vhdl_Wrapper; 512end Synth.Disp_Vhdl; 513