diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-12-03 03:08:23 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-12-03 03:08:23 +0100 |
commit | d0be4f8e5157e751f4e450402ac47b5c69ea35be (patch) | |
tree | 0177f456a2584b7cb0ed2e46a8e18d83094f3ccd /src/grt | |
parent | d10afd56d89ca9654e22de141496bf06ceeaa2f4 (diff) | |
download | ghdl-d0be4f8e5157e751f4e450402ac47b5c69ea35be.tar.gz ghdl-d0be4f8e5157e751f4e450402ac47b5c69ea35be.tar.bz2 ghdl-d0be4f8e5157e751f4e450402ac47b5c69ea35be.zip |
fix VHDL 08 preprocessor block comments in libraries to start in column 1
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-fst.adb | 124 |
1 files changed, 122 insertions, 2 deletions
diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb index e6d9e6721..a81022be9 100644 --- a/src/grt/grt-fst.adb +++ b/src/grt/grt-fst.adb @@ -39,9 +39,16 @@ with Grt.Hooks; use Grt.Hooks; with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Types; use Grt.Rtis_Types; with Grt.Vstrings; +with Ada.Unchecked_Deallocation; pragma Elaborate_All (Grt.Table); package body Grt.Fst is + -- FST format has a mechanism to declare signal aliases (if two signals + -- in the hierarchy are the same). Enabling this reduce the number of + -- signals dumped, but weirdly it makes the FST file slightly bigger. + Flag_Aliases : constant Boolean := True; + + -- Global FST context. Set to non-NULL iff dumping signals to an FST file. Context : fstContext := Null_fstContext; -- Index type of the table of vcd variables to dump. @@ -115,6 +122,80 @@ package body Grt.Fst is Put_Line ("Fst.Avhpi_Error!"); end Avhpi_Error; + function Equal (Left, Right : Verilog_Wire_Info) return Boolean + is + Len : Ghdl_Index_Type; + begin + if Left.Kind /= Right.Kind + or else Left.Val /= Right.Val + then + return False; + end if; + + -- Get length. + Len := Get_Wire_Length (Left); + if Len /= Get_Wire_Length (Right) then + return False; + end if; + + -- Compare signals. + for I in 1 .. Len loop + if Left.Sigs (I - 1) /= Right.Sigs (I - 1) then + return False; + end if; + end loop; + return True; + end Equal; + + function Hash (El : Verilog_Wire_Info) return Ghdl_Index_Type + is + Len : constant Ghdl_Index_Type := Get_Wire_Length (El); + Res : Ghdl_Index_Type; + Iaddr : Integer_Address; + begin + Res := Vcd_Var_Kind'Pos (El.Kind) * 2 + Vcd_Value_Kind'Pos (El.Val); + Res := Res + Len * 29; + for I in 1 .. Len loop + Iaddr := To_Integer (El.Sigs (I - 1).all'Address); + Res := Res + + Ghdl_Index_Type (Iaddr mod Integer_Address (Ghdl_Index_Type'Last)); + end loop; + return Res; + end Hash; + + -- Very simple hash table to detect aliases. + type Bucket_Type; + type Bucket_Acc is access Bucket_Type; + + type Bucket_Type is record + El : Fst_Index_Type; + Next : Bucket_Acc; + end record; + + type Hash_Table is array (Ghdl_Index_Type range <>) of Bucket_Acc; + type Hash_Table_Acc is access Hash_Table; + + Hash_Tab : Hash_Table_Acc; + + procedure Free_Hash_Tab + is + procedure Free_Hash_Table is new + Ada.Unchecked_Deallocation (Hash_Table, Hash_Table_Acc); + procedure Free_Bucket_Type is new + Ada.Unchecked_Deallocation (Bucket_Type, Bucket_Acc); + Ent, Nent : Bucket_Acc; + begin + for I in Hash_Tab'Range loop + Ent := Hash_Tab (I); + while Ent /= null loop + Nent := Ent.Next; + Free_Bucket_Type (Ent); + Ent := Nent; + end loop; + end loop; + Free_Hash_Table (Hash_Tab); + end Free_Hash_Tab; + procedure Fst_Add_Signal (Sig : VhpiHandleT) is Vcd_El : Verilog_Wire_Info; @@ -125,6 +206,8 @@ package body Grt.Fst is Name : String (1 .. 128); Name_Len : Natural; Hand : fstHandle; + Alias : fstHandle; + H : Ghdl_Index_Type; begin Get_Verilog_Wire (Sig, Vcd_El); @@ -181,6 +264,25 @@ package body Grt.Fst is Dir := FST_VD_IMPLICIT; end if; + -- Try to find an alias. + Alias := Null_fstHandle; + if Flag_Aliases then + declare + Ent : Bucket_Acc; + begin + H := Hash (Vcd_El) mod (Hash_Tab'Last + 1); + Ent := Hash_Tab (H); + while Ent /= null loop + if Equal (Fst_Table.Table (Ent.El).Wire, Vcd_El) then + Alias := Fst_Table.Table (Ent.El).Hand; + exit; + else + Ent := Ent.Next; + end if; + end loop; + end; + end if; + Vhpi_Get_Str (VhpiNameP, Sig, Name, Name_Len); if Name_Len >= Name'Length or else Vcd_El.Irange /= null @@ -217,16 +319,25 @@ package body Grt.Fst is Hand := fstWriterCreateVar2 (Context, Vt, Dir, Len, To_Ghdl_C_String (Name2'Address), - Null_fstHandle, null, FST_SVT_VHDL_SIGNAL, Sdt); + Alias, null, FST_SVT_VHDL_SIGNAL, Sdt); end; else Name (Name_Len) := NUL; Hand := fstWriterCreateVar2 (Context, Vt, Dir, Len, To_Ghdl_C_String (Name'Address), - Null_fstHandle, null, FST_SVT_VHDL_SIGNAL, Sdt); + Alias, null, FST_SVT_VHDL_SIGNAL, Sdt); + end if; + + if Flag_Aliases and then Interfaces.C."/=" (Alias, Null_fstHandle) then + return; end if; Fst_Table.Append (Fst_Sig_Info'(Wire => Vcd_El, Hand => Hand)); + + if Flag_Aliases then + Hash_Tab (H) := new Bucket_Type'(El => Fst_Table.Last, + Next => Hash_Tab (H)); + end if; end Fst_Add_Signal; procedure Fst_Put_Hierarchy (Inst : VhpiHandleT); @@ -417,10 +528,19 @@ package body Grt.Fst is -- Be sure the RTI of std_ulogic is set. Search_Types_RTI; + if Flag_Aliases then + Hash_Tab := + new Hash_Table (0 .. Ghdl_Index_Type (Sig_Table.Last / 17)); + end if; + -- Put hierarchy. Get_Root_Inst (Root); Fst_Put_Hierarchy (Root); + if Flag_Aliases then + Free_Hash_Tab; + end if; + Register_Cycle_Hook (Fst_Cycle'Access); end Fst_Start; |