From 5a498b26f5fef355533f482aba3978fd8ca16464 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 16 May 2020 21:29:51 +0200 Subject: synth: use memtyp for synth-ieee-numeric_std, add more signed mul. --- src/synth/synth-ieee-numeric_std.adb | 553 ++++++++++++++++---------------- src/synth/synth-ieee-numeric_std.ads | 34 +- src/synth/synth-ieee-std_logic_1164.adb | 31 ++ src/synth/synth-ieee-std_logic_1164.ads | 6 + src/synth/synth-static_oper.adb | 212 +----------- 5 files changed, 350 insertions(+), 486 deletions(-) create mode 100644 src/synth/synth-ieee-std_logic_1164.adb (limited to 'src') diff --git a/src/synth/synth-ieee-numeric_std.adb b/src/synth/synth-ieee-numeric_std.adb index e7cc2ef65..89f428580 100644 --- a/src/synth/synth-ieee-numeric_std.adb +++ b/src/synth/synth-ieee-numeric_std.adb @@ -19,6 +19,7 @@ -- MA 02110-1301, USA. with Types_Utils; use Types_Utils; +with Synth.Errors; use Synth.Errors; package body Synth.Ieee.Numeric_Std is Null_Vec : constant Std_Logic_Vector (1 .. 0) := (others => '0'); @@ -45,418 +46,426 @@ package body Synth.Ieee.Numeric_Std is type Uns_To_01_Array is array (Uns64 range 0 .. 1) of Sl_X01; Uns_To_01 : constant Uns_To_01_Array := (0 => '0', 1 => '1'); - function Add_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector - is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Len : constant Integer := Integer'Max (L'Last, R'Last); - subtype Res_Type is Std_Logic_Vector (1 .. Len); - Res : Res_Type; - Lb, Rb, Carry : Sl_X01; + function Create_Res_Type (Otyp : Type_Acc; Len : Uns32) return Type_Acc is begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; + if Otyp.Vbound.Len = Len + and then Otyp.Vbound.Right = 0 + and then Otyp.Vbound.Dir = Dir_Downto + then + pragma Assert (Otyp.Vbound.Left = Int32 (Len) - 1); + return Otyp; end if; - Carry := '0'; - for I in 0 .. Len - 1 loop - if I >= L'Last then - Lb := '0'; - else - Lb := Sl_To_X01 (L (L'Last - I)); - end if; - if I >= R'Last then - Rb := '0'; - else - Rb := Sl_To_X01 (R (R'Last - I)); - end if; - if Lb = 'X' or Rb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); - exit; - end if; - Res (Res'Last - I) := Compute_Sum (Carry, Rb, Lb); - Carry := Compute_Carry (Carry, Rb, Lb); + return Create_Vec_Type_By_Length (Len, Otyp.Vec_El); + end Create_Res_Type; + + procedure Fill (Res : Memtyp; V : Std_Ulogic) is + begin + for I in 1 .. Res.Typ.Vbound.Len loop + Write_Std_Logic (Res.Mem, I - 1, V); end loop; - return Res; - end Add_Uns_Uns; + end Fill; - function Add_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector + function Add_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Syn_Src) + return Memtyp is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Len : constant Integer := Integer'Max (L'Last, R'Last); - subtype Res_Type is Std_Logic_Vector (1 .. Len); - Res : Res_Type; + Llen : constant Uns32 := L.Typ.Vbound.Len; + Rlen : constant Uns32 := R.Typ.Vbound.Len; + Len : constant Uns32 := Uns32'Max (Llen, Rlen); + Res : Memtyp; Lb, Rb, Carry : Sl_X01; + R_Ext, L_Ext : Sl_X01; begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + + if Len = 0 then + return Res; end if; + + if Signed then + -- Extend with the sign bit. + L_Ext := Sl_To_X01 (Read_Std_Logic (L.Mem, 0)); + R_Ext := Sl_To_X01 (Read_Std_Logic (R.Mem, 0)); + else + -- Extend with '0'. + L_Ext := '0'; + R_Ext := '0'; + end if; + Carry := '0'; - for I in 0 .. Len - 1 loop - if I >= L'Last then - Lb := L (1); + for I in 1 .. Len loop + if I > Llen then + Lb := L_Ext; else - Lb := L (L'Last - I); + Lb := Sl_To_X01 (Read_Std_Logic (L.Mem, Llen - I)); end if; - Lb := Sl_To_X01 (Lb); - if I >= R'Last then - Rb := R (1); + if I > Rlen then + Rb := R_Ext; else - Rb := R (R'Last - I); + Rb := Sl_To_X01 (Read_Std_Logic (R.Mem, Rlen - I)); end if; - Rb := Sl_To_X01 (Rb); if Lb = 'X' or Rb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""+"": non logical value detected"); + Fill (Res, 'X'); exit; end if; - Res (Res'Last - I) := Compute_Sum (Carry, Rb, Lb); + Write_Std_Logic (Res.Mem, Len - I, Compute_Sum (Carry, Rb, Lb)); Carry := Compute_Carry (Carry, Rb, Lb); end loop; return Res; + end Add_Vec_Vec; + + function Add_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + begin + return Add_Vec_Vec (L, R, False, Loc); + end Add_Uns_Uns; + + function Add_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + begin + return Add_Vec_Vec (L, R, True, Loc); end Add_Sgn_Sgn; - function Add_Sgn_Int (L : Std_Logic_Vector; R : Int64) - return Std_Logic_Vector + function Add_Vec_Int + (L : Memtyp; R : Uns64; Signed : Boolean; Loc : Syn_Src) return Memtyp is - pragma Assert (L'First = 1); - Res : Std_Logic_Vector (1 .. L'Last); + Len : constant Uns32 := L.Typ.Vbound.Len; + Res : Memtyp; V : Uns64; Lb, Rb, Carry : Sl_X01; begin - if L'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Len < 1 then + return Res; end if; - V := To_Uns64 (R); + V := R; Carry := '0'; - for I in reverse Res'Range loop - Lb := Sl_To_X01 (L (I)); + for I in 1 .. Len loop + Lb := Sl_To_X01 (Read_Std_Logic (L.Mem, Len - I)); Rb := Uns_To_01 (V and 1); if Lb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""+"": non logical value detected"); + Fill (Res, 'X'); exit; end if; - Res (I) := Compute_Sum (Carry, Rb, Lb); + Write_Std_Logic (Res.Mem, Len - I, Compute_Sum (Carry, Rb, Lb)); Carry := Compute_Carry (Carry, Rb, Lb); - V := Shift_Right_Arithmetic (V, 1); + if Signed then + V := Shift_Right_Arithmetic (V, 1); + else + V := Shift_Right (V, 1); + end if; end loop; return Res; + end Add_Vec_Int; + + function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp is + begin + return Add_Vec_Int (L, To_Uns64 (R), True, Loc); end Add_Sgn_Int; - function Add_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector - is - pragma Assert (L'First = 1); - Res : Std_Logic_Vector (1 .. L'Last); - V : Uns64; - Lb, Rb, Carry : Sl_X01; + function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp is begin - if L'Last < 1 then - return Null_Vec; - end if; - V := R; - Carry := '0'; - for I in reverse Res'Range loop - Lb := Sl_To_X01 (L (I)); - Rb := Uns_To_01 (V and 1); - if Lb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); - exit; - end if; - Res (I) := Compute_Sum (Carry, Rb, Lb); - Carry := Compute_Carry (Carry, Rb, Lb); - V := Shift_Right (V, 1); - end loop; - return Res; + return Add_Vec_Int (L, R, True, Loc); end Add_Uns_Nat; - function Sub_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector + function Sub_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Syn_Src) + return Memtyp is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Len : constant Integer := Integer'Max (L'Last, R'Last); - subtype Res_Type is Std_Logic_Vector (1 .. Len); - Res : Res_Type; + Llen : constant Uns32 := L.Typ.Vbound.Len; + Rlen : constant Uns32 := R.Typ.Vbound.Len; + Len : constant Uns32 := Uns32'Max (Llen, Rlen); + Res : Memtyp; Lb, Rb, Carry : Sl_X01; + R_Ext, L_Ext : Sl_X01; begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + + if Len = 0 then + return Res; end if; + + if Signed then + -- Extend with the sign bit. + L_Ext := Sl_To_X01 (Read_Std_Logic (L.Mem, 0)); + R_Ext := Sl_To_X01 (Read_Std_Logic (R.Mem, 0)); + else + -- Extend with '0'. + L_Ext := '0'; + R_Ext := '0'; + end if; + Carry := '1'; - for I in 0 .. Len - 1 loop - if I >= L'Last then - Lb := '0'; + for I in 1 .. Len loop + if I > Llen then + Lb := L_Ext; else - Lb := Sl_To_X01 (L (L'Last - I)); + Lb := Sl_To_X01 (Read_Std_Logic (L.Mem, Llen - I)); end if; - if I >= R'Last then - Rb := '1'; + if I > Rlen then + Rb := R_Ext; else - Rb := Sl_To_X01 (R (R'Last - I)); - Rb := Not_Table (Rb); + Rb := Sl_To_X01 (Read_Std_Logic (R.Mem, Rlen - I)); end if; + Rb := Not_Table (Rb); if Lb = 'X' or Rb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""-"": non logical value detected"); + Fill (Res, 'X'); exit; end if; - Res (Res'Last - I) := Compute_Sum (Carry, Rb, Lb); + Write_Std_Logic (Res.Mem, Len - I, Compute_Sum (Carry, Rb, Lb)); Carry := Compute_Carry (Carry, Rb, Lb); end loop; return Res; + end Sub_Vec_Vec; + + function Sub_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + begin + return Sub_Vec_Vec (L, R, False, Loc); end Sub_Uns_Uns; - function Sub_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector + function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + begin + return Sub_Vec_Vec (L, R, True, Loc); + end Sub_Sgn_Sgn; + + function Sub_Vec_Int + (L : Memtyp; R : Uns64; Signed : Boolean; Loc : Syn_Src) return Memtyp is - pragma Assert (L'First = 1); - Res : Std_Logic_Vector (1 .. L'Last); - V : Uns64; + Len : constant Uns32 := L.Typ.Vbound.Len; + Res : Memtyp; + V : Uns64; Lb, Rb, Carry : Sl_X01; begin - if L'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Len < 1 then + return Res; end if; V := R; Carry := '1'; - for I in reverse Res'Range loop - Lb := Sl_To_X01 (L (I)); + for I in 1 .. Len loop + Lb := Sl_To_X01 (Read_Std_Logic (L.Mem, Len - I)); Rb := Uns_To_01 (V and 1); - Rb := Not_Table (Rb); if Lb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""+"": non logical value detected"); + Fill (Res, 'X'); exit; end if; - Res (I) := Compute_Sum (Carry, Rb, Lb); + Rb := Not_Table (Rb); + Write_Std_Logic (Res.Mem, Len - I, Compute_Sum (Carry, Rb, Lb)); Carry := Compute_Carry (Carry, Rb, Lb); - V := Shift_Right (V, 1); - end loop; - return Res; - end Sub_Uns_Nat; - - function Sub_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector - is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Len : constant Integer := Integer'Max (L'Last, R'Last); - subtype Res_Type is Std_Logic_Vector (1 .. Len); - Res : Res_Type; - Lb, Rb, Carry : Sl_X01; - begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; - end if; - Carry := '1'; - for I in 0 .. Len - 1 loop - if I >= L'Last then - Lb := L (1); - else - Lb := L (L'Last - I); - end if; - Lb := Sl_To_X01 (Lb); - if I >= R'Last then - Rb := R (1); + if Signed then + V := Shift_Right_Arithmetic (V, 1); else - Rb := R (R'Last - I); + V := Shift_Right (V, 1); end if; - Rb := Sl_To_X01 (Rb); - Rb := Not_Table (Rb); - if Lb = 'X' or Rb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); - exit; - end if; - Res (Res'Last - I) := Compute_Sum (Carry, Rb, Lb); - Carry := Compute_Carry (Carry, Rb, Lb); end loop; return Res; - end Sub_Sgn_Sgn; + end Sub_Vec_Int; - function Sub_Sgn_Int (L : Std_Logic_Vector; R : Int64) - return Std_Logic_Vector - is - pragma Assert (L'First = 1); - Res : Std_Logic_Vector (1 .. L'Last); - V : Uns64; - Lb, Rb, Carry : Sl_X01; + function Sub_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp is begin - if L'Last < 1 then - return Null_Vec; - end if; - V := To_Uns64 (R); - Carry := '1'; - for I in reverse Res'Range loop - Lb := Sl_To_X01 (L (I)); - Rb := Uns_To_01 (V and 1); - Rb := Not_Table (Rb); - if Lb = 'X' then - --assert NO_WARNING - -- report "NUMERIC_STD.""+"": non logical value detected" - -- severity warning; - Res := (others => 'X'); - exit; - end if; - Res (I) := Compute_Sum (Carry, Rb, Lb); - Carry := Compute_Carry (Carry, Rb, Lb); - V := Shift_Right_Arithmetic (V, 1); - end loop; - return Res; + return Sub_Vec_Int (L, To_Uns64 (R), True, Loc); end Sub_Sgn_Int; - function Mul_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector + function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp is + begin + return Sub_Vec_Int (L, R, True, Loc); + end Sub_Uns_Nat; + + function Mul_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Len : constant Integer := L'Last + R'Last; - Res : Std_Logic_Vector (1 .. Len); + Llen : constant Uns32 := L.Typ.Vbound.Len; + Rlen : constant Uns32 := R.Typ.Vbound.Len; + Len : constant Uns32 := Llen + Rlen; + Res : Memtyp; Lb, Rb, Vb, Carry : Sl_X01; begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Llen = 0 or Rlen = 0 then + return Res; end if; - Res := (others => '0'); + Fill (Res, '0'); -- Shift and add L. - for I in 0 .. R'Last - 1 loop - Rb := Sl_To_X01 (R (R'Last - I)); + for I in 1 .. Rlen loop + Rb := Sl_To_X01 (Read_Std_Logic (R.Mem, Rlen - I)); if Rb = '1' then -- Compute res := res + shift_left (l, i). Carry := '0'; - for J in 0 .. L'Last - 1 loop - Lb := L (L'Last - J); - Vb := Res (Len - (I + J)); - Res (Len - (I + J)) := Compute_Sum (Carry, Vb, Lb); + for J in 1 .. Llen loop + Lb := Read_Std_Logic (L.Mem, Llen - J); + Vb := Read_Std_Logic (Res.Mem, Len - (I + J - 1)); + Write_Std_Logic + (Res.Mem, Len - (I + J - 1), Compute_Sum (Carry, Vb, Lb)); Carry := Compute_Carry (Carry, Vb, Lb); end loop; -- Propagate carry. - for J in I + L'Last .. Res'Last loop + for J in I + Llen .. Len loop exit when Carry = '0'; - Vb := Res (Len - J); - Res (Len - J) := Xor_Table (Carry, Vb); + Vb := Read_Std_Logic (Res.Mem, Len - J); + Write_Std_Logic (Res.Mem, Len - J, Xor_Table (Carry, Vb)); Carry := And_Table (Carry, Vb); end loop; elsif Rb = 'X' then - null; - -- assert NO_WARNING - -- report "NUMERIC_STD.""*"": non logical value detected" - -- severity warning; + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""*"": non logical value detected"); + Fill (Res, 'X'); + exit; end if; end loop; return Res; end Mul_Uns_Uns; - procedure To_Unsigned (Res : out Std_Logic_Vector; Val : Uns64) + function To_Unsigned (Val : Uns64; Vtyp : Type_Acc) return Memtyp is - E : Std_Ulogic; + Vlen : constant Uns32 := Vtyp.Vbound.Len; + Res : Memtyp; + E : Std_Ulogic; begin - for I in Res'Range loop - if (Shift_Right (Val, Natural (Res'Last - I)) and 1) = 0 then + Res := Create_Memory (Vtyp); + for I in 1 .. Vlen loop + if (Shift_Right (Val, Natural (I - 1)) and 1) = 0 then E := '0'; else E := '1'; end if; - Res (I) := E; + Write_Std_Logic (Res.Mem, Vlen - I, E); end loop; + return Res; end To_Unsigned; - function Mul_Nat_Uns (L : Uns64; R : Std_Logic_Vector) - return Std_Logic_Vector + function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Syn_Src) return Memtyp is - pragma Assert (R'First = 1); - T : Std_Logic_Vector (1 .. R'Last); + Lv : Memtyp; begin - if R'Last < 1 then - return Null_Vec; + if R.Typ.Vbound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ end if; - To_Unsigned (T, L); - return Mul_Uns_Uns (T, R); + Lv := To_Unsigned (L, R.Typ); + return Mul_Uns_Uns (Lv, R, Loc); end Mul_Nat_Uns; - function Mul_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector + function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp is - pragma Assert (L'First = 1); - T : Std_Logic_Vector (1 .. L'Last); + Rv : Memtyp; begin - if L'Last < 1 then - return Null_Vec; + if L.Typ.Vbound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ end if; - To_Unsigned (T, R); - return Mul_Uns_Uns (L, T); + Rv := To_Unsigned (R, L.Typ); + return Mul_Uns_Uns (L, Rv, Loc); end Mul_Uns_Nat; - function Mul_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector + function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp is - pragma Assert (L'First = 1); - pragma Assert (R'First = 1); - Res : Std_Logic_Vector (1 .. L'Last + R'Last); + Llen : constant Uns32 := L.Typ.Vbound.Len; + Rlen : constant Uns32 := R.Typ.Vbound.Len; + Len : constant Uns32 := Llen + Rlen; + Res : Memtyp; Lb, Rb, Vb, Carry : Sl_X01; begin - if L'Last < 1 or R'Last < 1 then - return Null_Vec; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Llen = 0 or Rlen = 0 then + return Res; end if; - Res := (others => '0'); + Fill (Res, '0'); -- Shift and add L, do not consider (yet) the sign bit of R. - for I in 0 .. R'Last - 2 loop - Rb := Sl_To_X01 (R (R'Last - I)); + for I in 1 .. Rlen - 1 loop + Rb := Sl_To_X01 (Read_Std_Logic (R.Mem, Rlen - I)); if Rb = '1' then -- Compute res := res + shift_left (l, i). Carry := '0'; - for J in 0 .. L'Last - 1 loop - Lb := L (L'Last - J); - Vb := Res (Res'Last - (I + J)); - Res (Res'Last - (I + J)) := Compute_Sum (Carry, Vb, Lb); + for J in 1 .. Llen loop + Lb := Read_Std_Logic (L.Mem, Llen - J); + Vb := Read_Std_Logic (Res.Mem, Len - (I + J - 1)); + Write_Std_Logic + (Res.Mem, Len - (I + J - 1), Compute_Sum (Carry, Vb, Lb)); Carry := Compute_Carry (Carry, Vb, Lb); end loop; -- Sign extend and propagate carry. - Lb := R (1); - for J in I + L'Last .. Res'Last - 1 loop - Vb := Res (Res'Last - J); - Res (Res'Last - J) := Compute_Sum (Carry, Vb, Lb); + Lb := Read_Std_Logic (L.Mem, 0); + for J in I + Llen .. Len loop + Vb := Read_Std_Logic (Res.Mem, Len - J); + Write_Std_Logic (Res.Mem, Len - J, Compute_Sum (Carry, Vb, Lb)); Carry := Compute_Carry (Carry, Vb, Lb); end loop; elsif Rb = 'X' then - null; - -- assert NO_WARNING - -- report "NUMERIC_STD.""*"": non logical value detected" - -- severity warning; + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""*"": non logical value detected"); + Fill (Res, 'X'); + exit; end if; end loop; - if R (1) = '1' then + if Read_Std_Logic (R.Mem, 0) = '1' then -- R is a negative number. It is considered as: -- -2**n + (Rn-1 Rn-2 ... R0). -- Compute res := res - 2**n * l. Carry := '1'; - for I in 0 .. L'Last - 1 loop - Vb := Res (Res'Last - (R'Last - 1 + I)); - Lb := Not_Table (L (L'Last - I)); - Res (Res'Last - (R'Last - 1 + I)) := Compute_Sum (Carry, Vb, Lb); + for I in 1 .. Llen loop + -- Start at len - (rlen - 1) = llen + 1 + Vb := Read_Std_Logic (Res.Mem, Llen - I + 1); + Lb := Not_Table (Read_Std_Logic (L.Mem, Llen - I)); + Write_Std_Logic + (Res.Mem, Llen - I + 1, Compute_Sum (Carry, Vb, Lb)); Carry := Compute_Carry (Carry, Vb, Lb); end loop; - Vb := Res (1); - Lb := Not_Table (L (1)); - Res (1) := Compute_Sum (Carry, Vb, Lb); + -- The last bit. + Vb := Read_Std_Logic (Res.Mem, 0); + Lb := Not_Table (Read_Std_Logic (L.Mem, 0)); + Write_Std_Logic (Res.Mem, 0, Compute_Sum (Carry, Vb, Lb)); end if; return Res; end Mul_Sgn_Sgn; + function To_Signed (Val : Int64; Vtyp : Type_Acc) return Memtyp + is + Vlen : constant Uns32 := Vtyp.Vbound.Len; + Uval : constant Uns64 := To_Uns64 (Val); + Res : Memtyp; + E : Std_Ulogic; + begin + Res := Create_Memory (Vtyp); + for I in 1 .. Vlen loop + if (Shift_Right_Arithmetic (Uval, Natural (I - 1)) and 1) = 0 then + E := '0'; + else + E := '1'; + end if; + Write_Std_Logic (Res.Mem, Vlen - I, E); + end loop; + return Res; + end To_Signed; + + function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Syn_Src) return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Vbound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Signed (L, R.Typ); + return Mul_Sgn_Sgn (Lv, R, Loc); + end Mul_Int_Sgn; + + function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Vbound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Signed (R, L.Typ); + return Mul_Sgn_Sgn (L, Rv, Loc); + end Mul_Sgn_Int; + function Neg_Sgn (V : Std_Logic_Vector) return Std_Logic_Vector is pragma Assert (V'First = 1); diff --git a/src/synth/synth-ieee-numeric_std.ads b/src/synth/synth-ieee-numeric_std.ads index 280be3da5..c9324f7ea 100644 --- a/src/synth/synth-ieee-numeric_std.ads +++ b/src/synth/synth-ieee-numeric_std.ads @@ -20,6 +20,8 @@ with Types; use Types; +with Synth.Objtypes; use Synth.Objtypes; +with Synth.Source; use Synth.Source; with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; package Synth.Ieee.Numeric_Std is @@ -28,27 +30,23 @@ package Synth.Ieee.Numeric_Std is function Neg_Sgn (V : Std_Logic_Vector) return Std_Logic_Vector; -- "+" - function Add_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector; - function Add_Sgn_Int (L : Std_Logic_Vector; R : Int64) - return Std_Logic_Vector; - function Add_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector; - function Add_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector; + function Add_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Add_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; + function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; -- "-" - function Sub_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector; - function Sub_Sgn_Int (L : Std_Logic_Vector; R : Int64) - return Std_Logic_Vector; - function Sub_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector; - function Sub_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector; + function Sub_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Sub_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; + function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; -- "*" - function Mul_Uns_Uns (L, R : Std_Logic_Vector) return Std_Logic_Vector; - function Mul_Nat_Uns (L : Uns64; R : Std_Logic_Vector) - return Std_Logic_Vector; - function Mul_Uns_Nat (L : Std_Logic_Vector; R : Uns64) - return Std_Logic_Vector; + function Mul_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Syn_Src) return Memtyp; + function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; - function Mul_Sgn_Sgn (L, R : Std_Logic_Vector) return Std_Logic_Vector; + function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Syn_Src) return Memtyp; + function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; end Synth.Ieee.Numeric_Std; diff --git a/src/synth/synth-ieee-std_logic_1164.adb b/src/synth/synth-ieee-std_logic_1164.adb new file mode 100644 index 000000000..7249164b4 --- /dev/null +++ b/src/synth/synth-ieee-std_logic_1164.adb @@ -0,0 +1,31 @@ +-- std_logic_1164 +-- Copyright (C) 2020 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. + +package body Synth.Ieee.Std_Logic_1164 is + function Read_Std_Logic (M : Memory_Ptr; Off : Uns32) return Std_Ulogic is + begin + return Std_Ulogic'Val (Read_U8 (M + Size_Type (Off))); + end Read_Std_Logic; + + procedure Write_Std_Logic (M : Memory_Ptr; Off : Uns32; Val : Std_Ulogic) is + begin + Write_U8 (M + Size_Type (Off), Std_Ulogic'Pos (Val)); + end Write_Std_Logic; +end Synth.Ieee.Std_Logic_1164; diff --git a/src/synth/synth-ieee-std_logic_1164.ads b/src/synth/synth-ieee-std_logic_1164.ads index 14309cd42..fc82c94b8 100644 --- a/src/synth/synth-ieee-std_logic_1164.ads +++ b/src/synth/synth-ieee-std_logic_1164.ads @@ -18,6 +18,9 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Types; use Types; +with Synth.Objtypes; use Synth.Objtypes; + package Synth.Ieee.Std_Logic_1164 is -- From openieee. @@ -37,6 +40,9 @@ package Synth.Ieee.Std_Logic_1164 is subtype X01 is Std_Ulogic range 'X' .. '1'; + function Read_Std_Logic (M : Memory_Ptr; Off : Uns32) return Std_Ulogic; + procedure Write_Std_Logic (M : Memory_Ptr; Off : Uns32; Val : Std_Ulogic); + -- Vector of logic state. -- First index is the leftest. type Std_Logic_Vector is array (Natural range <>) of Std_Ulogic; diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index 770c5d171..440df4c0a 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -42,16 +42,6 @@ package body Synth.Static_Oper is -- (math library) on unix systems. pragma Linker_Options ("-lm"); - function Read_Std_Logic (M : Memory_Ptr; Off : Uns32) return Std_Ulogic is - begin - return Std_Ulogic'Val (Read_U8 (M + Size_Type (Off))); - end Read_Std_Logic; - - procedure Write_Std_Logic (M : Memory_Ptr; Off : Uns32; Val : Std_Ulogic) is - begin - Write_U8 (M + Size_Type (Off), Std_Ulogic'Pos (Val)); - end Write_Std_Logic; - procedure Warn_Compare_Null (Loc : Node) is begin Warning_Msg_Synth (+Loc, "null argument detected, returning false"); @@ -386,180 +376,6 @@ package body Synth.Static_Oper is return Res; end To_Memtyp; - function Synth_Add_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Add_Uns_Uns (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Add_Uns_Uns; - - function Synth_Add_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Add_Sgn_Sgn (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Add_Sgn_Sgn; - - function Synth_Add_Sgn_Int (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Val : constant Int64 := Read_Discrete (R); - begin - To_Std_Logic_Vector (L, L_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Add_Sgn_Int (L_Arr, R_Val); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Add_Sgn_Int; - - function Synth_Add_Uns_Nat (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Typ.W)); - R_Val : constant Uns64 := Uns64 (Read_Discrete (R)); - begin - To_Std_Logic_Vector (L, L_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Add_Uns_Nat (L_Arr, R_Val); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Add_Uns_Nat; - - function Synth_Sub_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Sub_Uns_Uns (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Sub_Uns_Uns; - - function Synth_Sub_Uns_Nat (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Val : constant Uns64 := Uns64 (Read_Discrete (R)); - begin - To_Std_Logic_Vector (L, L_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Sub_Uns_Nat (L_Arr, R_Val); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Sub_Uns_Nat; - - function Synth_Sub_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Sub_Sgn_Sgn (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Sub_Sgn_Sgn; - - function Synth_Sub_Sgn_Int (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Val : constant Int64 := Read_Discrete (R); - begin - To_Std_Logic_Vector (L, L_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Sub_Sgn_Int (L_Arr, R_Val); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Sub_Sgn_Int; - - function Synth_Mul_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Mul_Uns_Uns (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Mul_Uns_Uns; - - function Synth_Mul_Nat_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - L_Val : constant Uns64 := Uns64 (Read_Discrete (L)); - begin - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Mul_Nat_Uns (L_Val, R_Arr); - begin - return To_Memtyp (Res_Arr, R.Typ.Vec_El); - end; - end Synth_Mul_Nat_Uns; - - function Synth_Mul_Uns_Nat (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Val : constant Uns64 := Uns64 (Read_Discrete (R)); - begin - To_Std_Logic_Vector (L, L_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Mul_Uns_Nat (L_Arr, R_Val); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Mul_Uns_Nat; - - function Synth_Mul_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); - R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); - begin - To_Std_Logic_Vector (L, L_Arr); - To_Std_Logic_Vector (R, R_Arr); - declare - Res_Arr : constant Std_Logic_Vector := Mul_Sgn_Sgn (L_Arr, R_Arr); - begin - return To_Memtyp (Res_Arr, L.Typ.Vec_El); - end; - end Synth_Mul_Sgn_Sgn; - function Synth_Shift (Val : Memtyp; Amt : Uns32; Right : Boolean; @@ -1019,36 +835,40 @@ package body Synth.Static_Oper is | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Log | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Slv | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Uns_Uns_Slv => - return Synth_Add_Uns_Uns (Left, Right, Expr); + return Add_Uns_Uns (Left, Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Int => - return Synth_Add_Sgn_Int (Left, Right, Expr); + return Add_Sgn_Int (Left, Read_Discrete (Right), Expr); when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Int => - return Synth_Add_Uns_Nat (Left, Right, Expr); + return Add_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn => - return Synth_Add_Sgn_Sgn (Left, Right, Expr); + return Add_Sgn_Sgn (Left, Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Uns => - return Synth_Sub_Uns_Uns (Left, Right, Expr); + return Sub_Uns_Uns (Left, Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat => - return Synth_Sub_Uns_Nat (Left, Right, Expr); + return Sub_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Int => - return Synth_Sub_Sgn_Int (Left, Right, Expr); + return Sub_Sgn_Int (Left, Read_Discrete (Right), Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Sgn => - return Synth_Sub_Sgn_Sgn (Left, Right, Expr); + return Sub_Sgn_Sgn (Left, Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Uns_Uns => - return Synth_Mul_Uns_Uns (Left, Right, Expr); + return Mul_Uns_Uns (Left, Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Nat_Uns => - return Synth_Mul_Nat_Uns (Left, Right, Expr); + return Mul_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Uns_Nat => - return Synth_Mul_Uns_Nat (Left, Right, Expr); + return Mul_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Sgn => - return Synth_Mul_Sgn_Sgn (Left, Right, Expr); + return Mul_Sgn_Sgn (Left, Right, Expr); + when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Int => + return Mul_Sgn_Int (Left, Read_Discrete (Right), Expr); + when Iir_Predefined_Ieee_Numeric_Std_Mul_Int_Sgn => + return Mul_Int_Sgn (Read_Discrete (Left), Right, Expr); when Iir_Predefined_Ieee_Numeric_Std_Srl_Uns_Int | Iir_Predefined_Ieee_Numeric_Std_Srl_Sgn_Int => -- cgit v1.2.3