From b7a36d7d7838d05b449aa7e23935cd0e3e4213d4 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 17 Sep 2019 02:18:01 +0200 Subject: synth-inference: detect false loop. --- src/dyn_interning.adb | 126 ++++++++++++++++++++++++++++++++++++++++++ src/dyn_interning.ads | 89 +++++++++++++++++++++++++++++ src/synth/netlists-gates.ads | 2 + src/synth/netlists.adb | 5 ++ src/synth/netlists.ads | 4 ++ src/synth/synth-inference.adb | 111 ++++++++++++++++++++++++++++++++++++- 6 files changed, 335 insertions(+), 2 deletions(-) create mode 100644 src/dyn_interning.adb create mode 100644 src/dyn_interning.ads diff --git a/src/dyn_interning.adb b/src/dyn_interning.adb new file mode 100644 index 000000000..adda22437 --- /dev/null +++ b/src/dyn_interning.adb @@ -0,0 +1,126 @@ +-- Type interning - set of unique objects. +-- Copyright (C) 2019 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Unchecked_Deallocation; + +package body Dyn_Interning is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Hash_Array, Hash_Array_Acc); + + procedure Init (Inst : out Instance) is + begin + Inst.Size := Initial_Size; + Inst.Hash_Table := new Hash_Array'(0 .. Initial_Size - 1 => No_Index); + Wrapper_Tables.Init (Inst.Els); + pragma Assert (Wrapper_Tables.Last (Inst.Els) = No_Index); + end Init; + + procedure Free (Inst : in out Instance) is + begin + Deallocate (Inst.Hash_Table); + Inst.Size := 0; + Wrapper_Tables.Free (Inst.Els); + end Free; + + -- Expand the hash table (double the size). + procedure Expand (Inst : in out Instance) + is + Old_Hash_Table : Hash_Array_Acc; + Idx : Index_Type; + begin + Old_Hash_Table := Inst.Hash_Table; + Inst.Size := Inst.Size * 2; + Inst.Hash_Table := new Hash_Array'(0 .. Inst.Size - 1 => No_Index); + + -- Rehash. + for I in Old_Hash_Table'Range loop + Idx := Old_Hash_Table (I); + while Idx /= No_Index loop + -- Note: collisions are put in reverse order. + declare + Ent : Element_Wrapper renames Inst.Els.Table (Idx); + Hash_Index : constant Hash_Value_Type := + Ent.Hash and (Inst.Size - 1); + Next_Idx : constant Index_Type := Ent.Next; + begin + Ent.Next := Inst.Hash_Table (Hash_Index); + Inst.Hash_Table (Hash_Index) := Idx; + Idx := Next_Idx; + end; + end loop; + end loop; + + Deallocate (Old_Hash_Table); + end Expand; + + procedure Get + (Inst : in out Instance; Params : Params_Type; Res : out Object_Type) + is + Hash_Value : Hash_Value_Type; + Hash_Index : Hash_Value_Type; + Idx : Index_Type; + begin + -- Check if the package was initialized. + pragma Assert (Inst.Hash_Table /= null); + + Hash_Value := Hash (Params); + Hash_Index := Hash_Value and (Inst.Size - 1); + + Idx := Inst.Hash_Table (Hash_Index); + while Idx /= No_Index loop + declare + E : Element_Wrapper renames Inst.Els.Table (Idx); + begin + if E.Hash = Hash_Value and then Equal (E.Obj, Params) then + Res := E.Obj; + return; + end if; + Idx := E.Next; + end; + end loop; + + -- Maybe expand the table. + if Hash_Value_Type (Wrapper_Tables.Last (Inst.Els)) > 2 * Inst.Size then + Expand (Inst); + + -- Recompute hash index. + Hash_Index := Hash_Value and (Inst.Size - 1); + end if; + + Res := Build (Params); + + -- Insert. + Wrapper_Tables.Append (Inst.Els, + (Hash => Hash_Value, + Next => Inst.Hash_Table (Hash_Index), + Obj => Res)); + Inst.Hash_Table (Hash_Index) := Wrapper_Tables.Last (Inst.Els); + end Get; + + function Last_Index (Inst : Instance) return Index_Type is + begin + return Wrapper_Tables.Last (Inst.Els); + end Last_Index; + + function Get_By_Index (Inst : Instance; Index : Index_Type) + return Object_Type is + begin + pragma Assert (Index <= Wrapper_Tables.Last (Inst.Els)); + return Inst.Els.Table (Index).Obj; + end Get_By_Index; +end Dyn_Interning; diff --git a/src/dyn_interning.ads b/src/dyn_interning.ads new file mode 100644 index 000000000..2b5dc5ee4 --- /dev/null +++ b/src/dyn_interning.ads @@ -0,0 +1,89 @@ +-- Type interning - set of unique objects. +-- Copyright (C) 2019 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Hash; use Hash; +with Dyn_Tables; + +-- This generic package provides a factory to build unique objects. +-- Get will return an existing object or create a new one. +generic + -- Parameters of the object to be created. + type Params_Type (<>) is private; + + -- Object to be built and stored. + type Object_Type is private; + + -- Reduce PARAMS to a small value. + -- The required property is: Hash(P1) /= Hash(P2) => P1 /= P2. + with function Hash (Params : Params_Type) return Hash_Value_Type; + + -- Create an object from PARAMS. + with function Build (Params : Params_Type) return Object_Type; + + -- Return True iff OBJ is the object corresponding to PARAMS. + with function Equal (Obj : Object_Type; Params : Params_Type) + return Boolean; +package Dyn_Interning is + type Instance is limited private; + + -- Initialize. Required before any other operation. + procedure Init (Inst : out Instance); + + procedure Free (Inst : in out Instance); + + -- If there is already an existing object for PARAMS, return it. + -- Otherwise create it. + procedure Get + (Inst : in out Instance; Params : Params_Type; Res : out Object_Type); + + type Index_Type is new Uns32; + No_Index : constant Index_Type := 0; + First_Index : constant Index_Type := 1; + + -- Get the number of elements in the table. + function Last_Index (Inst : Instance) return Index_Type; + + -- Get an element by index. The index has no real meaning, but the + -- current implementation allocates index incrementally. + function Get_By_Index (Inst : Instance; Index : Index_Type) + return Object_Type; +private + type Element_Wrapper is record + Hash : Hash_Value_Type; + Next : Index_Type := No_Index; + Obj : Object_Type; + end record; + + package Wrapper_Tables is new Dyn_Tables + (Table_Index_Type => Index_Type, + Table_Component_Type => Element_Wrapper, + Table_Low_Bound => No_Index + 1, + Table_Initial => 128); + + type Hash_Array is array (Hash_Value_Type range <>) of Index_Type; + type Hash_Array_Acc is access Hash_Array; + + Initial_Size : constant Hash_Value_Type := 1024; + + type Instance is record + Els : Wrapper_Tables.Instance; + Size : Hash_Value_Type; + Hash_Table : Hash_Array_Acc; + end record; +end Dyn_Interning; diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads index 124f933a4..b33da9778 100644 --- a/src/synth/netlists-gates.ads +++ b/src/synth/netlists-gates.ads @@ -86,6 +86,8 @@ package Netlists.Gates is -- Output: o Id_Mux4 : constant Module_Id := 37; + subtype Mux_Module_Id is Module_Id range Id_Mux2 .. Id_Mux4; + -- Like a wire: the output is equal to the input, but could be elimited -- at any time. Isignal has an initial value. Id_Signal : constant Module_Id := 38; diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb index 1bde22ac6..66854a714 100644 --- a/src/synth/netlists.adb +++ b/src/synth/netlists.adb @@ -297,6 +297,11 @@ package body Netlists is Table_Low_Bound => No_Param_Idx, Table_Initial => 256); + function Hash (Inst : Instance) return Hash_Value_Type is + begin + return Hash_Value_Type (Inst); + end Hash; + procedure Extract_All_Instances (M : Module; First_Instance : out Instance) is pragma Assert (Is_Valid (M)); diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads index 0e7647b79..49c9144db 100644 --- a/src/synth/netlists.ads +++ b/src/synth/netlists.ads @@ -19,6 +19,7 @@ -- MA 02110-1301, USA. with Types; use Types; +with Hash; use Hash; package Netlists is -- Netlists. @@ -103,6 +104,9 @@ package Netlists is type Instance is private; No_Instance : constant Instance; + -- Hash INST (simply return its index). + function Hash (Inst : Instance) return Hash_Value_Type; + -- A net is an output of a gate or a sub-circuit. A net can be connected -- to several inputs. type Net is private; diff --git a/src/synth/synth-inference.adb b/src/synth/synth-inference.adb index 56f1fca3d..376a48840 100644 --- a/src/synth/synth-inference.adb +++ b/src/synth/synth-inference.adb @@ -18,6 +18,8 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Dyn_Interning; + with Netlists.Utils; use Netlists.Utils; with Netlists.Gates; use Netlists.Gates; with Netlists.Gates_Ports; use Netlists.Gates_Ports; @@ -338,6 +340,111 @@ package body Synth.Inference is Add_Conc_Assign (Wid, Res, Off, Stmt); end Infere_FF; + function Id_Instance (Param : Instance) return Instance is + begin + return Param; + end Id_Instance; + + package Inst_Interning is new Dyn_Interning + (Params_Type => Instance, + Object_Type => Instance, + Hash => Netlists.Hash, + Build => Id_Instance, + Equal => "="); + + -- Detect false combinational loop. They can easily appear when variables + -- are only used in one branch: + -- process (all) + -- variable a : std_logic; + -- begin + -- r <= '1'; + -- if sel = '1' then + -- a := '1'; + -- r <= '0'; + -- end if; + -- end process; + -- There is a combinational path from 'a' to 'a' as + -- a := (sel = '1') ? '1' : a; + -- But this is a false loop because the value of 'a' is never used. In + -- that case, 'a' is assigned to 'x' and all the unused logic will be + -- removed during clean-up. + -- + -- Detection is very simple: the closure of readers of 'a' must be only + -- muxes (which were inserted by controls). + function Is_False_Loop (Prev_Val : Net) return Boolean + is + use Inst_Interning; + T : Inst_Interning.Instance; + + function Add_From_Net (N : Net) return Boolean + is + Inst : Netlists.Instance; + Inp : Input; + begin + Inp := Get_First_Sink (N); + while Inp /= No_Input loop + Inst := Get_Input_Parent (Inp); + if Get_Id (Inst) not in Mux_Module_Id then + return False; + end if; + + -- Add to T (if not already). + Get (T, Inst, Inst); + + Inp := Get_Next_Sink (Inp); + end loop; + + return True; + end Add_From_Net; + + function Walk_Nets (N : Net) return Boolean + is + Inst : Netlists.Instance; + begin + -- Put gates that read the value. + if not Add_From_Net (N) then + return False; + end if; + + -- Follow the outputs. + for I in First_Index .. Index_Type'Last loop + exit when I > Inst_Interning.Last_Index (T); + Inst := Get_By_Index (T, I); + if not Add_From_Net (Get_Output (Inst, 0)) then + return False; + end if; + end loop; + + -- No external readers. + return True; + end Walk_Nets; + + Res : Boolean; + begin + Inst_Interning.Init (T); + + Res := Walk_Nets (Prev_Val); + + Inst_Interning.Free (T); + + return Res; + end Is_False_Loop; + + procedure Infere_Latch (Ctxt : Context_Acc; Val : Net; Prev_Val : Net) + is + X : Net; + begin + -- In case of false loop, do not close the loop but assign X. + if Is_False_Loop (Prev_Val) then + X := Build_Const_X (Ctxt, Get_Width (Val)); + Connect (Get_Input (Get_Net_Parent (Prev_Val), 0), X); + return; + end if; + + -- Latch or combinational loop. + raise Internal_Error; + end Infere_Latch; + procedure Infere (Ctxt : Context_Acc; Wid : Wire_Id; Val : Net; @@ -364,8 +471,8 @@ package body Synth.Inference is Sel := Get_Mux2_Sel (Last_Mux); Extract_Clock (Get_Driver (Sel), Clk, Enable); if Clk = No_Net then - -- No clock -> latch - raise Internal_Error; + -- No clock -> latch or combinational loop + Infere_Latch (Ctxt, Val, Prev_Val); else -- Clock -> FF Infere_FF (Ctxt, Wid, Prev_Val, Off, Last_Mux, Clk, Enable, Stmt); -- cgit v1.2.3