diff options
| -rw-r--r-- | src/synth/netlists-folds.adb | 47 | ||||
| -rw-r--r-- | src/synth/netlists-utils.adb | 29 | ||||
| -rw-r--r-- | src/synth/netlists-utils.ads | 6 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 50 |
4 files changed, 82 insertions, 50 deletions
diff --git a/src/synth/netlists-folds.adb b/src/synth/netlists-folds.adb index fd35ed8ed..9028c15ea 100644 --- a/src/synth/netlists-folds.adb +++ b/src/synth/netlists-folds.adb @@ -21,6 +21,7 @@ with Types_Utils; use Types_Utils; with Netlists.Gates; use Netlists.Gates; +with Netlists.Utils; use Netlists.Utils; with Netlists.Locations; package body Netlists.Folds is @@ -136,11 +137,29 @@ package body Netlists.Folds is if Wn = W then return I; else - if Wn > W then - Res := Build_Trunc (Ctxt, Id_Utrunc, I, W); + if W <= 64 and then Is_Const_Net (I) then + declare + V : Uns64; + begin + V := Get_Net_Uns64 (I); + if Wn < W then + -- Extend. + pragma Assert (Shift_Right (V, Natural (Wn)) = 0); + null; + else + -- Truncate + V := Shift_Left (V, Natural (64 - Wn)); + V := Shift_Right (V, Natural (64 - Wn)); + end if; + Res := Build2_Const_Uns (Ctxt, V, W); + end; else - pragma Assert (Wn < W); - Res := Build_Extend (Ctxt, Id_Uextend, I, W); + if Wn > W then + Res := Build_Trunc (Ctxt, Id_Utrunc, I, W); + else + pragma Assert (Wn < W); + Res := Build_Extend (Ctxt, Id_Uextend, I, W); + end if; end if; Locations.Set_Location (Res, Loc); return Res; @@ -159,11 +178,23 @@ package body Netlists.Folds is if Wn = W then return I; else - if Wn > W then - Res := Build_Trunc (Ctxt, Id_Strunc, I, W); + if W <= 64 and then Is_Const_Net (I) then + declare + V : Uns64; + Sh : constant Natural := Natural (Width'Min (Wn, W)); + begin + V := Get_Net_Uns64 (I); + V := Shift_Left (V, 64 - Sh); + V := Shift_Right_Arithmetic (V, 64 - Sh); + Res := Build2_Const_Int (Ctxt, To_Int64 (V), W); + end; else - pragma Assert (Wn < W); - Res := Build_Extend (Ctxt, Id_Sextend, I, W); + if Wn > W then + Res := Build_Trunc (Ctxt, Id_Strunc, I, W); + else + pragma Assert (Wn < W); + Res := Build_Extend (Ctxt, Id_Sextend, I, W); + end if; end if; Locations.Set_Location (Res, Loc); return Res; diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb index 7d9d71f5b..d3861215e 100644 --- a/src/synth/netlists-utils.adb +++ b/src/synth/netlists-utils.adb @@ -18,8 +18,11 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. -with Netlists.Gates; use Netlists.Gates; with Mutils; +with Types_Utils; use Types_Utils; + +with Netlists.Gates; use Netlists.Gates; + package body Netlists.Utils is function Get_Nbr_Inputs (Inst : Instance) return Port_Nbr @@ -122,6 +125,30 @@ package body Netlists.Utils is return Is_Const_Module (Get_Id (Get_Net_Parent (N))); end Is_Const_Net; + function Get_Net_Uns64 (N : Net) return Uns64 + is + Inst : constant Instance := Get_Net_Parent (N); + begin + case Get_Id (Inst) is + when Id_Const_UB32 => + declare + Va : constant Uns32 := Get_Param_Uns32 (Inst, 0); + Wd : constant Width := Get_Width (N); + begin + -- There must not be any garbage. + pragma Assert (Shift_Right (Va, Natural (Wd)) = 0); + return Uns64 (Va); + end; + when others => + raise Internal_Error; + end case; + end Get_Net_Uns64; + + function Get_Net_Int64 (N : Net) return Int64 is + begin + return To_Int64 (Get_Net_Uns64 (N)); + end Get_Net_Int64; + function Is_Connected (O : Net) return Boolean is begin return Get_First_Sink (O) /= No_Input; diff --git a/src/synth/netlists-utils.ads b/src/synth/netlists-utils.ads index e8565c823..67a06cecd 100644 --- a/src/synth/netlists-utils.ads +++ b/src/synth/netlists-utils.ads @@ -45,6 +45,12 @@ package Netlists.Utils is function Is_Const_Module (Id : Module_Id) return Boolean; function Is_Const_Net (N : Net) return Boolean; + -- Assuming than N is a const net, return the value (for small values). + function Get_Net_Uns64 (N : Net) return Uns64; + + function Get_Net_Int64 (N : Net) return Int64; + pragma Inline (Get_Net_Int64); + -- Return True iff O has at least one sink (ie is connected to at least one -- input). function Is_Connected (O : Net) return Boolean; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index f1bdeeead..fddc32954 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -51,7 +51,6 @@ package body Synth.Expr is function Get_Const_Discrete (V : Value_Acc) return Int64 is N : Net; - Inst : Instance; begin case V.Kind is when Value_Discrete => @@ -65,20 +64,7 @@ package body Synth.Expr is when others => raise Internal_Error; end case; - Inst := Get_Net_Parent (N); - case Get_Id (Inst) is - when Id_Const_UB32 => - declare - Va : constant Uns32 := Get_Param_Uns32 (Inst, 0); - Wd : constant Natural := Natural (Get_Width (N)); - T : Uns64; - begin - T := Shift_Left (Uns64 (Va), 64 - Wd); - return To_Int64 (Shift_Right_Arithmetic (T, 64 - Wd)); - end; - when others => - raise Internal_Error; - end case; + return Get_Net_Int64 (N); end Get_Const_Discrete; procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is @@ -806,16 +792,20 @@ package body Synth.Expr is declare N : Net; begin - if Vtype.W > Dtype.W then + if Vtype.W /= Dtype.W then -- Truncate. -- TODO: check overflow. case Val.Kind is when Value_Net | Value_Wire => N := Get_Net (Val); - N := Build_Trunc - (Build_Context, Id_Utrunc, N, Dtype.W); - Set_Location (N, Loc); + if Vtype.Drange.Is_Signed then + N := Build2_Sresize + (Build_Context, N, Dtype.W, Get_Location (Loc)); + else + N := Build2_Uresize + (Build_Context, N, Dtype.W, Get_Location (Loc)); + end if; return Create_Value_Net (N, Dtype); when Value_Discrete => return Create_Value_Discrete (Val.Scal, Dtype); @@ -824,28 +814,6 @@ package body Synth.Expr is when others => raise Internal_Error; end case; - elsif Vtype.W < Dtype.W then - -- Extend. - case Val.Kind is - when Value_Discrete => - return Create_Value_Discrete (Val.Scal, Dtype); - when Value_Const => - return Create_Value_Discrete (Val.C_Val.Scal, Dtype); - when Value_Net - | Value_Wire => - N := Get_Net (Val); - if Vtype.Drange.Is_Signed then - N := Build_Extend - (Build_Context, Id_Sextend, N, Dtype.W); - else - N := Build_Extend - (Build_Context, Id_Uextend, N, Dtype.W); - end if; - Set_Location (N, Loc); - return Create_Value_Net (N, Dtype); - when others => - raise Internal_Error; - end case; else -- TODO: check overflow if sign differ. return Val; |