-- Highler level API to build a netlist - do some optimizations.
-- Copyright (C) 2019 Tristan Gingold
--
-- This file is part of GHDL.
--
-- This program 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 of the License, or
-- (at your option) any later version.
--
-- This program 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 this program; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
-- MA 02110-1301, USA.
with Types_Utils; use Types_Utils;
with Netlists.Gates; use Netlists.Gates;
with Netlists.Utils; use Netlists.Utils;
with Netlists.Locations; use Netlists.Locations;
package body Netlists.Folds is
function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
return Net is
begin
if Val < 2**32 then
return Build_Const_UB32 (Ctxt, Uns32 (Val), W);
else
pragma Assert (W > 32);
declare
Inst : Instance;
begin
Inst := Build_Const_Bit (Ctxt, W);
Set_Param_Uns32 (Inst, 0, Uns32 (Val and 16#ffff_ffff#));
Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (Val, 32)));
for I in 2 .. (W + 31) / 32 loop
Set_Param_Uns32 (Inst, Param_Idx (I), 0);
end loop;
return Get_Output (Inst, 0);
end;
end if;
end Build2_Const_Uns;
function Build2_Const_Vec (Ctxt : Context_Acc; W : Width; V : Uns32_Arr)
return Net is
begin
if W <= 32 then
return Build_Const_UB32 (Ctxt, V (V'First), W);
else
declare
Inst : Instance;
begin
Inst := Build_Const_Bit (Ctxt, W);
for I in V'Range loop
Set_Param_Uns32 (Inst, Param_Idx (I - V'First), V (I));
end loop;
return Get_Output (Inst, 0);
end;
end if;
end Build2_Const_Vec;
function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
return Net is
begin
if Val in -2**31 .. 2**31 - 1 then
return Build_Const_SB32 (Ctxt, Int32 (Val), W);
else
pragma Assert (W > 32);
declare
V : constant Uns64 := To_Uns64 (Val);
S : constant Uns32 :=
Uns32 (Shift_Right_Arithmetic (V, 63) and 16#ffff_ffff#);
Inst : Instance;
begin
Inst := Build_Const_Bit (Ctxt, W);
Set_Param_Uns32 (Inst, 0, Uns32 (V and 16#ffff_ffff#));
Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (V, 32)));
for I in 2 .. (W + 31) / 32 loop
Set_Param_Uns32 (Inst, Param_Idx (I), S);
end loop;
return Get_Output (Inst, 0);
end;
end if;
end Build2_Const_Int;
function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net
is
F : constant Int32 := Els'First;
Len : constant Natural := Els'Length;
Wd : Width;
Inst : Instance;
N : Net;
begin
case Len is
when 0 =>
raise Internal_Error;
when 1 =>
N := Els (F);
when 2 =>
N := Build_Concat2 (Ctxt, Els (F + 1), Els (F));
when 3 =>
N := Build_Concat3 (Ctxt, Els (F + 2), Els (F + 1), Els (F));
when 4 =>
N := Build_Concat4
(Ctxt, Els (F + 3), Els (F + 2), Els (F + 1), Els (F));
when 5 .. Natural'Last =>
-- Compute length.
Wd := 0;
for I in Els'Range loop
Wd := Wd + Get_Width (Els (I));
end loop;
N := Build_Concatn (Ctxt, Wd, Uns32 (Len));
Inst := Get_Net_Parent (N);
for I in Els'Range loop
Connect (Get_Input (Inst, Port_Idx (Els'Last - I)), Els (I));
end loop;
end case;
return N;
end Build2_Concat;
function Build2_Trunc (Ctxt : Context_Acc;
Id : Module_Id;
I : Net;
W : Width;
Loc : Location_Type)
return Net
is
I_Inst : constant Instance := Get_Net_Parent (I);
I_Id : constant Module_Id := Get_Id (I_Inst);
Res : Net;
begin
if I_Id not in Extend_Module_Id then
Res := Build_Trunc (Ctxt, Id, I, W);
Set_Location (Res, Loc);
return Res;
end if;
-- So there are 3 widths:
-- W: the width of the result
-- Iw : the width of the input
-- Vw : the width of the original value.
-- And we have:
-- Iw > W (as we truncate)
-- Iw > Vw (as V was extended)
declare
Iw : constant Width := Get_Width (I);
V : constant Net := Get_Input_Net (I_Inst, 0);
Vw : constant Width := Get_Width (V);
pragma Assert (Iw > W);
pragma Assert (Iw > Vw);
begin
if W = Vw then
-- Truncation of an extension with no size change -> no-op.
return V;
elsif W < Vw then
-- At the end, the initial value is truncated.
Res := Build_Trunc (Ctxt, Id, V, W);
else
pragma Assert (W > Vw);
-- Just extend less.
Res := Build_Extend (Ctxt, I_Id, V, W);
end if;
Set_Location (Res, Loc);
return Res;
end;
end Build2_Trunc;
function Build2_Uresize (Ctxt : Context_Acc;
I : Net;
W : Width;
Loc : Location_Type := No_Location)
return Net
is
Wn : constant Width := Get_Width (I);
Res : Net;
begin
if Wn = W then
return I;
else
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
if Wn > W then
return Build2_Trunc (Ctxt, Id_Utrunc, I, W, Loc);
else
pragma Assert (Wn < W);
Res := Build_Extend (Ctxt, Id_Uextend, I, W);
end if;
end if;
Locations.Set_Location (Res, Loc);
return Res;
end if;
end Build2_Uresize;
function Build2_Sresize (Ctxt : Context_Acc;
I : Net;
W : Width;
Loc : Location_Type := No_Location)
return Net
is
Wn : constant Width := Get_Width (I);
Res : Net;
begin
if Wn = W then
return I;
else
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
if Wn > W then
return Build2_Trunc (Ctxt, Id_Strunc, I, W, Loc);
else
pragma Assert (Wn < W);
Res := Build_Extend (Ctxt, Id_Sextend, I, W);
end if;
end if;
Set_Location (Res, Loc);
return Res;
end if;
end Build2_Sresize;
function Build2_Extract
(Ctxt : Context_Acc; I : Net; Off, W : Width) return Net is
begin
if Off = 0 and then W = Get_Width (I) then
return I;
else
return Build_Extract (Ctxt, I, Off, W);
end if;
end Build2_Extract;
end Netlists.Folds;