aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/synth/netlists-builders.adb44
-rw-r--r--src/synth/netlists-builders.ads10
-rw-r--r--src/synth/netlists-disp_vhdl.adb64
-rw-r--r--src/synth/netlists-dump.adb17
-rw-r--r--src/synth/netlists-gates.ads6
-rw-r--r--src/synth/netlists-utils.adb7
-rw-r--r--src/synth/netlists.adb19
-rw-r--r--src/synth/synth-context.adb182
-rw-r--r--src/synth/synth-decls.adb1
-rw-r--r--src/synth/synth-expr.adb203
-rw-r--r--src/synth/synth-expr.ads4
-rw-r--r--src/synth/synth-stmts.adb8
-rw-r--r--src/synth/synth-values.adb18
-rw-r--r--src/synth/synth-values.ads12
-rw-r--r--src/vhdl/vhdl-nodes.ads2
15 files changed, 445 insertions, 152 deletions
diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index 7274fc0a6..d1c0b3785 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -156,6 +156,20 @@ package body Netlists.Builders is
Ctxt.M_Const_Z := Res;
Outputs := (0 => Create_Output ("o"));
Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs);
+
+ Res := New_User_Module
+ (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_bit")),
+ Id_Const_Bit, 0, 1, 0);
+ Ctxt.M_Const_Bit := Res;
+ Outputs := (0 => Create_Output ("o"));
+ Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs);
+
+ Res := New_User_Module
+ (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_log")),
+ Id_Const_Log, 0, 1, 0);
+ Ctxt.M_Const_Log := Res;
+ Outputs := (0 => Create_Output ("o"));
+ Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs);
end Create_Const_Modules;
procedure Create_Extract_Module (Ctxt : Context_Acc)
@@ -184,7 +198,7 @@ package body Netlists.Builders is
begin
Res := New_User_Module
(Ctxt.Design, New_Sname_Artificial (Get_Identifier ("dyn_extract")),
- Id_Extract, 2, 1, 2);
+ Id_Dyn_Extract, 2, 1, 2);
Ctxt.M_Dyn_Extract := Res;
Outputs := (0 => Create_Output ("o"));
Inputs := (0 => Create_Input ("i"),
@@ -588,6 +602,34 @@ package body Netlists.Builders is
return O;
end Build_Const_UL32;
+ function Build_Const_Bit (Ctxt : Context_Acc; W : Width)
+ return Instance
+ is
+ Inst : Instance;
+ O : Net;
+ begin
+ Inst := New_Var_Instance (Ctxt.Parent, Ctxt.M_Const_Bit,
+ New_Internal_Name (Ctxt),
+ 0, 1, Param_Idx ((W + 31) / 32));
+ O := Get_Output (Inst, 0);
+ Set_Width (O, W);
+ return Inst;
+ end Build_Const_Bit;
+
+ function Build_Const_Log (Ctxt : Context_Acc; W : Width)
+ return Instance
+ is
+ Inst : Instance;
+ O : Net;
+ begin
+ Inst := New_Var_Instance (Ctxt.Parent, Ctxt.M_Const_Log,
+ New_Internal_Name (Ctxt),
+ 0, 1, 2 * Param_Idx ((W + 31) / 32));
+ O := Get_Output (Inst, 0);
+ Set_Width (O, W);
+ return Inst;
+ end Build_Const_Log;
+
function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net
is
pragma Assert (Get_Width (Src) = 1);
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index 3dbced990..8a5a0bd39 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -60,6 +60,14 @@ package Netlists.Builders is
Xz : Uns32;
W : Width) return Net;
+ -- Large constants.
+ -- Bit means only 0 or 1.
+ -- Log means 0/1/Z/X. Parameters 2N are aval, 2N+1 are bval.
+ function Build_Const_Bit (Ctxt : Context_Acc;
+ W : Width) return Instance;
+ function Build_Const_Log (Ctxt : Context_Acc;
+ W : Width) return Instance;
+
function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net;
function Build_Mux2 (Ctxt : Context_Acc;
@@ -140,6 +148,8 @@ private
M_Const_UB32 : Module;
M_Const_UL32 : Module;
M_Const_Z : Module;
+ M_Const_Bit : Module;
+ M_Const_Log : Module;
M_Edge : Module;
M_Mux2 : Module;
M_Mux4 : Module;
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index f889510f3..eb86f0c6d 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -283,19 +283,40 @@ package body Netlists.Disp_Vhdl is
end if;
end Get_Lit_Quote;
- procedure Disp_Binary_Lit (Va : Uns32; Zx : Uns32; Wd : Width)
- is
- W : constant Natural := Natural (Wd);
- Q : constant Character := Get_Lit_Quote (Wd);
+ procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is
begin
- Put (Q);
for I in 1 .. W loop
Put (Bchar (((Va / 2**(W - I)) and 1)
+ ((Zx / 2**(W - I)) and 1) * 2));
end loop;
+ end Disp_Binary_Digits;
+
+ procedure Disp_Binary_Lit (Va : Uns32; Zx : Uns32; Wd : Width)
+ is
+ Q : constant Character := Get_Lit_Quote (Wd);
+ begin
+ Put (Q);
+ Disp_Binary_Digits (Va, Zx, Natural (Wd));
Put (Q);
end Disp_Binary_Lit;
+ procedure Disp_Const_Bit (Inst : Instance)
+ is
+ W : constant Width := Get_Width (Get_Output (Inst, 0));
+ Nd : constant Width := W / 32;
+ Ld : constant Natural := Natural (W mod 32);
+ begin
+ Put ('"');
+ if Ld > 0 then
+ Disp_Binary_Digits (Get_Param_Uns32 (Inst, Param_Idx (Nd)), 0, Ld);
+ end if;
+ for I in reverse 1 .. Nd loop
+ Disp_Binary_Digits
+ (Get_Param_Uns32 (Inst, Param_Idx (I - 1)), 0, 32);
+ end loop;
+ Put ('"');
+ end Disp_Const_Bit;
+
procedure Disp_X_Lit (W : Width)
is
Q : constant Character := Get_Lit_Quote (W);
@@ -491,6 +512,32 @@ package body Netlists.Disp_Vhdl is
end if;
Put_Line (";");
end;
+ when Id_Dyn_Extract =>
+ declare
+ O : constant Net := Get_Output (Inst, 0);
+ Wd : constant Width := Get_Width (O);
+ Step : constant Uns32 := Get_Param_Uns32 (Inst, 0);
+ Off : constant Uns32 := Get_Param_Uns32 (Inst, 1);
+ begin
+ Disp_Template (" \o0 <= \i0 (to_integer (\ui1)", Inst);
+ if Step /= 1 then
+ Disp_Template (" * \n0", Inst, (0 => Step));
+ end if;
+ if Off /= 0 then
+ Disp_Template (" + \n0", Inst, (0 => Off));
+ end if;
+ if Wd > 1 then
+ Disp_Template (" + \n0 - 1 downto to_integer (\ui1)",
+ Inst, (0 => Wd));
+ if Step /= 1 then
+ Disp_Template (" * \n0", Inst, (0 => Step));
+ end if;
+ if Off /= 0 then
+ Disp_Template (" + \n0", Inst, (0 => Off));
+ end if;
+ end if;
+ Put_Line (");");
+ end;
when Id_Insert =>
declare
Iw : constant Width := Get_Width (Get_Input_Net (Inst, 1));
@@ -536,6 +583,8 @@ package body Netlists.Disp_Vhdl is
Disp_Template (" \o0 <= ", Inst);
Disp_Constant_Inline (Inst);
Put_Line (";");
+ when Id_Const_Bit =>
+ null;
when Id_Adff =>
Disp_Template (" process (\i0, \i2)" & NL &
" begin" & NL &
@@ -615,7 +664,7 @@ package body Netlists.Disp_Vhdl is
declare
W : constant Width := Get_Width (Get_Output (Inst, 0));
begin
- Disp_Template (" \o0 <= \i0 (\n0 downto 0);",
+ Disp_Template (" \o0 <= \i0 (\n0 downto 0); -- trunc" & NL,
Inst, (0 => W - 1));
end;
when Id_Uextend =>
@@ -671,6 +720,9 @@ package body Netlists.Disp_Vhdl is
Put (" := ");
Disp_Constant_Inline
(Get_Parent (Get_Input_Net (Inst, 2)));
+ when Id_Const_Bit =>
+ Put (" := ");
+ Disp_Const_Bit (Inst);
when others =>
null;
end case;
diff --git a/src/synth/netlists-dump.adb b/src/synth/netlists-dump.adb
index e6bb8517e..5d33cc664 100644
--- a/src/synth/netlists-dump.adb
+++ b/src/synth/netlists-dump.adb
@@ -193,9 +193,9 @@ package body Netlists.Dump is
begin
-- Module id and name.
Put_Indent (Indent);
- Put ("module (");
+ Put ("module @");
Put_Trim (Module'Image (M));
- Put (") ");
+ Put (" ");
Dump_Name (Get_Name (M));
New_Line;
@@ -392,7 +392,12 @@ package body Netlists.Dump is
Dump_Name (Get_Name (M));
- if Get_Nbr_Params (M) > 0 then
+ if True then
+ Put ('@');
+ Put_Trim (Instance'Image (Inst));
+ end if;
+
+ if Get_Nbr_Params (Inst) > 0 then
declare
First : Boolean;
begin
@@ -415,12 +420,6 @@ package body Netlists.Dump is
Dump_Name (Get_Name (Inst));
end if;
- if True then
- Put ('[');
- Put_Trim (Instance'Image (Inst));
- Put (']');
- end if;
-
if Get_Nbr_Inputs (Inst) > 0 then
declare
First : Boolean;
diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads
index 9a077f2f7..649503796 100644
--- a/src/synth/netlists-gates.ads
+++ b/src/synth/netlists-gates.ads
@@ -147,16 +147,20 @@ package Netlists.Gates is
-- parameter, possibly signed or unsigned extended. For large width
-- (> 128), the value is stored in a table.
Id_Const_UB32 : constant Module_Id := 64;
+ Id_Const_UL32 : constant Module_Id := 70;
Id_Const_SB32 : constant Module_Id := 65;
Id_Const_UB64 : constant Module_Id := 66;
Id_Const_SB64 : constant Module_Id := 67;
Id_Const_UB128 : constant Module_Id := 68;
Id_Const_SB128 : constant Module_Id := 69;
- Id_Const_UL32 : constant Module_Id := 70;
Id_Const_SL32 : constant Module_Id := 71;
Id_Const_Z : constant Module_Id := 72;
Id_Const_0 : constant Module_Id := 73;
+ -- Large width.
+ Id_Const_Bit : constant Module_Id := 74;
+ Id_Const_Log : constant Module_Id := 75;
+
-- Concatenation with N inputs.
Id_Concatn : constant Module_Id := 80;
end Netlists.Gates;
diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 43546e02a..43da83719 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -52,7 +52,12 @@ package body Netlists.Utils is
is
M : constant Module := Get_Module (Inst);
begin
- return Get_Nbr_Params (M);
+ case Get_Id (M) is
+ when Id_Const_Bit =>
+ return Param_Nbr ((Get_Width (Get_Output (Inst, 0)) + 31) / 32);
+ when others =>
+ return Get_Nbr_Params (M);
+ end case;
end Get_Nbr_Params;
function Get_Param_Desc
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 72ceac948..1bde22ac6 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -19,6 +19,7 @@
-- MA 02110-1301, USA.
with Netlists.Utils; use Netlists.Utils;
+with Netlists.Gates;
with Tables;
package body Netlists is
@@ -664,11 +665,19 @@ package body Netlists is
function Get_Param_Desc (M : Module; Param : Param_Idx) return Param_Desc
is
+ use Netlists.Gates;
pragma Assert (Is_Valid (M));
- pragma Assert (Param < Get_Nbr_Params (M));
begin
- return Param_Desc_Table.Table
- (Modules_Table.Table (M).First_Param_Desc + Param_Desc_Idx (Param));
+ case Get_Id (M) is
+ when Id_Const_Bit
+ | Id_Const_Log =>
+ return (No_Sname, Param_Uns32);
+ when others =>
+ pragma Assert (Param < Get_Nbr_Params (M));
+ return Param_Desc_Table.Table
+ (Modules_Table.Table (M).First_Param_Desc
+ + Param_Desc_Idx (Param));
+ end case;
end Get_Param_Desc;
function Get_Param_Idx (Inst : Instance; Param : Param_Idx) return Param_Idx
@@ -683,7 +692,7 @@ package body Netlists is
is
pragma Assert (Is_Valid (Inst));
M : constant Module := Get_Module (Inst);
- pragma Assert (Param < Get_Nbr_Params (M));
+ pragma Assert (Param < Get_Nbr_Params (Inst));
pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32);
begin
return Params_Table.Table (Get_Param_Idx (Inst, Param));
@@ -693,7 +702,7 @@ package body Netlists is
is
pragma Assert (Is_Valid (Inst));
M : constant Module := Get_Module (Inst);
- pragma Assert (Param < Get_Nbr_Params (M));
+ pragma Assert (Param < Get_Nbr_Params (Inst));
pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32);
begin
Params_Table.Table (Get_Param_Idx (Inst, Param)) := Val;
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index f89a708b1..7681d8f3b 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -234,6 +234,123 @@ package body Synth.Context is
return Val.Typ;
end Get_Value_Type;
+ function Vec2net (Val : Value_Acc) return Net is
+ begin
+ if Val.Typ.Vbound.Len <= 32 then
+ declare
+ Len : constant Iir_Index32 := Iir_Index32 (Val.Typ.Vbound.Len);
+ R_Val, R_Zx : Uns32;
+ V, Zx : Uns32;
+ begin
+ R_Val := 0;
+ R_Zx := 0;
+ for I in 1 .. Len loop
+ To_Logic (Val.Arr.V (I).Scal, Val.Typ.Vec_El, V, Zx);
+ R_Val := R_Val or Shift_Left (V, Natural (Len - I));
+ R_Zx := R_Zx or Shift_Left (Zx, Natural (Len - I));
+ end loop;
+ if R_Zx = 0 then
+ return Build_Const_UB32 (Build_Context, R_Val, Uns32 (Len));
+ else
+ return Build_Const_UL32
+ (Build_Context, R_Val, R_Zx, Uns32 (Len));
+ end if;
+ end;
+ else
+ -- Need Uconst64 / UconstBig
+ raise Internal_Error;
+ end if;
+ end Vec2net;
+
+ pragma Unreferenced (Vec2net);
+
+ type Logic_32 is record
+ Val : Uns32; -- AKA aval
+ Zx : Uns32; -- AKA bval
+ end record;
+
+ type Digit_Index is new Natural;
+ type Logvec_Array is array (Digit_Index range <>) of Logic_32;
+
+ -- type Logvec_Array_Acc is access Logvec_Array;
+
+ procedure Value2net (Val : Value_Acc;
+ Vec : in out Logvec_Array;
+ Off : in out Uns32;
+ Has_Zx : in out Boolean) is
+ begin
+ case Val.Typ.Kind is
+ when Type_Bit =>
+ declare
+ Idx : constant Digit_Index := Digit_Index (Off / 32);
+ Pos : constant Natural := Natural (Off mod 32);
+ Va : Uns32;
+ Zx : Uns32;
+ begin
+ if Val.Typ = Logic_Type then
+ From_Std_Logic (Val.Scal, Va, Zx);
+ Has_Zx := Has_Zx or Zx /= 0;
+ else
+ Va := Uns32 (Val.Scal);
+ Zx := 0;
+ end if;
+ Va := Shift_Left (Va, Pos);
+ Zx := Shift_Left (Zx, Pos);
+ Vec (Idx).Val := Vec (Idx).Val or Va;
+ Vec (Idx).Zx := Vec (Idx).Zx or Zx;
+ Off := Off + 1;
+ end;
+ when Type_Vector =>
+ -- TODO: optimize off mod 32 = 0.
+ for I in reverse Val.Arr.V'Range loop
+ Value2net (Val.Arr.V (I), Vec, Off, Has_Zx);
+ end loop;
+ when Type_Array =>
+ for I in reverse Val.Arr.V'Range loop
+ Value2net (Val.Arr.V (I), Vec, Off, Has_Zx);
+ end loop;
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Value2net;
+
+ procedure Value2net
+ (Val : Value_Acc; W : Width; Vec : in out Logvec_Array; Res : out Net)
+ is
+ Off : Uns32;
+ Has_Zx : Boolean;
+ Inst : Instance;
+ begin
+ Has_Zx := False;
+ Off := 0;
+ Value2net (Val, Vec, Off, Has_Zx);
+ if W <= 32 then
+ -- 32 bit result.
+ if not Has_Zx then
+ Res := Build_Const_UB32 (Build_Context, Vec (0).Val, W);
+ else
+ Res := Build_Const_UL32
+ (Build_Context, Vec (0).Val, Vec (0).Zx, W);
+ end if;
+ return;
+ else
+ if not Has_Zx then
+ Inst := Build_Const_Bit (Build_Context, W);
+ for I in Vec'Range loop
+ Set_Param_Uns32 (Inst, Param_Idx (I), Vec (I).Val);
+ end loop;
+ Res := Get_Output (Inst, 0);
+ else
+ Inst := Build_Const_Log (Build_Context, W);
+ for I in Vec'Range loop
+ Set_Param_Uns32 (Inst, Param_Idx (2 * I), Vec (I).Val);
+ Set_Param_Uns32 (Inst, Param_Idx (2 * I + 1), Vec (I).Zx);
+ end loop;
+ Res := Get_Output (Inst, 0);
+ end if;
+ end if;
+ end Value2net;
+
function Get_Net (Val : Value_Acc) return Net is
begin
case Val.Kind is
@@ -250,52 +367,37 @@ package body Synth.Context is
I1 => Get_Net (Val.M_T));
end;
when Value_Discrete =>
- declare
- Va : Uns32;
- Zx : Uns32;
- begin
- if Val.Typ = Logic_Type then
- From_Std_Logic (Val.Scal, Va, Zx);
- if Zx = 0 then
- return Build_Const_UB32 (Build_Context, Va, 1);
- else
- return Build_Const_UL32 (Build_Context, Va, Zx, 1);
- end if;
- elsif Val.Typ = Boolean_Type then
- From_Bit (Val.Scal, Va);
- return Build_Const_UB32 (Build_Context, Va, 1);
- else
- return Build_Const_UB32
- (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W);
- end if;
- end;
- when Value_Array =>
- if Val.Typ.Vbound.Len <= 32 then
+ if Val.Typ.Kind = Type_Bit then
declare
- Len : constant Iir_Index32 :=
- Iir_Index32 (Val.Typ.Vbound.Len);
- R_Val, R_Zx : Uns32;
- V, Zx : Uns32;
+ V : Logvec_Array (0 .. 0) := (0 => (0, 0));
+ Res : Net;
begin
- R_Val := 0;
- R_Zx := 0;
- for I in 1 .. Len loop
- To_Logic (Val.Arr.V (I).Scal, Val.Typ.Vec_El, V, Zx);
- R_Val := R_Val or Shift_Left (V, Natural (Len - I));
- R_Zx := R_Zx or Shift_Left (Zx, Natural (Len - I));
- end loop;
- if R_Zx = 0 then
- return Build_Const_UB32
- (Build_Context, R_Val, Uns32 (Len));
- else
- return Build_Const_UL32
- (Build_Context, R_Val, R_Zx, Uns32 (Len));
- end if;
+ Value2net (Val, 1, V, Res);
+ return Res;
end;
+ elsif Val.Typ.Drange.W <= 32 then
+ return Build_Const_UB32
+ (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W);
else
- -- Need Uconst64 / UconstBig
raise Internal_Error;
end if;
+ when Value_Array =>
+ declare
+ W : constant Width := Get_Type_Width (Val.Typ);
+ Nd : constant Digit_Index := Digit_Index ((W + 31) / 32);
+ Res : Net;
+ begin
+ if Nd > 64 then
+ raise Internal_Error;
+ else
+ declare
+ Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0));
+ begin
+ Value2net (Val, W, Vec, Res);
+ return Res;
+ end;
+ end if;
+ end;
when others =>
raise Internal_Error;
end case;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index ee9f49fa4..8a22c2fa0 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -209,7 +209,6 @@ package body Synth.Decls is
-- The elaboration of an index constraint consists of the
-- declaration of each of the discrete ranges in the index
-- constraint in some order that is not defined by the language.
- Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
Etyp := Get_Value_Type (Syn_Inst, El_Type);
if Is_One_Dimensional_Array_Type (Atype) then
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 37e9a8a44..abdedf37b 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -157,26 +157,6 @@ package body Synth.Expr is
end case;
end Bit_Extract;
- function Dyn_Bit_Extract (Val : Value_Acc; Off : Net; Loc : Node)
- return Value_Acc
- is
- N : Net;
- begin
- case Val.Kind is
--- when Value_Array =>
--- pragma Assert (Val.Bounds.D (1).Len >= Off);
--- return Val.Arr.V (Iir_Index32 (Val.Bounds.D (1).Len - Off));
- when Value_Net
- | Value_Wire =>
- N := Build_Dyn_Extract
- (Build_Context, Get_Net (Val), Off, 1, 0, 1);
- Set_Location (N, Loc);
- return Create_Value_Net (N, Val.Typ.Vec_El);
- when others =>
- raise Internal_Error;
- end case;
- end Dyn_Bit_Extract;
-
function Synth_Uresize (N : Net; W : Width) return Net
is
Wn : constant Width := Get_Width (N);
@@ -203,6 +183,36 @@ package body Synth.Expr is
return Synth_Uresize (Get_Net (Val), W);
end Synth_Uresize;
+ -- Resize for a discrete value.
+ function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net
+ is
+ Wn : constant Width := Val.Typ.Drange.W;
+ N : Net;
+ Res : Net;
+ begin
+ if Is_Const (Val) then
+ raise Internal_Error;
+ end if;
+
+ N := Get_Net (Val);
+ if Wn > W then
+ Res := Build_Trunc (Build_Context, Id_Utrunc, N, W);
+ Set_Location (Res, Loc);
+ return Res;
+ elsif Wn < W then
+ if Val.Typ.Drange.Is_Signed then
+ Res := Build_Extend (Build_Context, Id_Sextend, N, W);
+ else
+ Res := Build_Extend (Build_Context, Id_Uextend, N, W);
+ end if;
+ Set_Location (Res, Loc);
+ return Res;
+ else
+ return N;
+ end if;
+ end Synth_Resize;
+
+
function Get_Index_Offset
(Index : Value_Acc; Bounds : Bound_Type; Expr : Iir) return Uns32 is
begin
@@ -553,7 +563,9 @@ package body Synth.Expr is
if Len < 0 then
Len := 0;
end if;
- return (Dir => Rng.Dir, W => Width (Clog2 (Uns64 (Len))),
+ return (Dir => Rng.Dir,
+ Wlen => Width (Clog2 (Uns64 (Len))),
+ Wbounds => Rng.W,
Left => Int32 (Rng.Left), Right => Int32 (Rng.Right),
Len => Uns32 (Len));
end Synth_Bounds_From_Range;
@@ -659,7 +671,8 @@ package body Synth.Expr is
Res := (Left => Int32 (Index_Bounds.Left),
Right => 0,
Dir => Index_Bounds.Dir,
- W => Width (Len),
+ Wbounds => Index_Bounds.W,
+ Wlen => Width (Clog2 (Uns64 (Len))),
Len => Uns32 (Len));
if Len = 0 then
@@ -1136,24 +1149,27 @@ package body Synth.Expr is
end case;
end Index_To_Offset;
- function Dyn_Index_To_Offset (Pfx : Value_Acc; Idx : Net; Loc : Node)
- return Net
+ function Dyn_Index_To_Offset
+ (Bnd : Bound_Type; Idx_Val : Value_Acc; Loc : Node) return Net
is
- Bnd : constant Type_Acc := Pfx.Typ;
+ Idx2 : Net;
Off : Net;
Right : Net;
begin
-- TODO: handle width.
- Right := Build_Const_UB32
- (Build_Context, To_Uns32 (Bnd.Vbound.Right), 32);
+ Right := Build_Const_UB32 (Build_Context, To_Uns32 (Bnd.Right),
+ Bnd.Wbounds);
Set_Location (Right, Loc);
- case Bnd.Vbound.Dir is
+
+ Idx2 := Synth_Resize (Idx_Val, Bnd.Wbounds, Loc);
+
+ case Bnd.Dir is
when Iir_To =>
-- L <= I <= R --> off = R - I
- Off := Build_Dyadic (Build_Context, Id_Sub, Right, Idx);
+ Off := Build_Dyadic (Build_Context, Id_Sub, Right, Idx2);
when Iir_Downto =>
-- L >= I >= R --> off = I - R
- Off := Build_Dyadic (Build_Context, Id_Sub, Idx, Right);
+ Off := Build_Dyadic (Build_Context, Id_Sub, Idx2, Right);
end case;
Set_Location (Off, Loc);
return Off;
@@ -1162,36 +1178,58 @@ package body Synth.Expr is
function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
return Value_Acc
is
- Pfx : constant Node := Get_Prefix (Name);
- Pfx_Val : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx);
Indexes : constant Iir_Flist := Get_Index_List (Name);
Idx_Expr : constant Node := Get_Nth_Element (Indexes, 0);
Idx_Val : Value_Acc;
+ Pfx_Val : Value_Acc;
begin
if Get_Nbr_Elements (Indexes) /= 1 then
- Error_Msg_Synth (+Name, "multi-dim arrays not supported");
+ Error_Msg_Synth (+Name, "multi-dim arrays not yet supported");
return null;
end if;
+ Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name));
+
+ -- Use the base type as the subtype of the index is not synth-ed.
Idx_Val := Synth_Expression_With_Type
(Syn_Inst, Idx_Expr, Get_Base_Type (Get_Type (Idx_Expr)));
- if Idx_Val.Kind = Value_Discrete then
- declare
- Off : Uns32;
- begin
- Off := Index_To_Offset (Pfx_Val, Idx_Val.Scal, Name);
- return Bit_Extract (Pfx_Val, Off, Name);
- end;
- else
+ if Pfx_Val.Typ.Kind = Type_Vector then
+ if Idx_Val.Kind = Value_Discrete then
+ declare
+ Off : Uns32;
+ begin
+ Off := Index_To_Offset (Pfx_Val, Idx_Val.Scal, Name);
+ return Bit_Extract (Pfx_Val, Off, Name);
+ end;
+ else
+ declare
+ Off : Net;
+ Res : Net;
+ begin
+ Off := Dyn_Index_To_Offset (Pfx_Val.Typ.Vbound, Idx_Val, Name);
+ Res := Build_Dyn_Extract
+ (Build_Context, Get_Net (Pfx_Val), Off, 1, 0, 1);
+ Set_Location (Res, Name);
+ return Create_Value_Net (Res, Pfx_Val.Typ.Vec_El);
+ end;
+ end if;
+ elsif Pfx_Val.Typ.Kind = Type_Array then
declare
- Idx : Net;
Off : Net;
+ Res : Net;
+ El_Width : Width;
begin
- Idx := Get_Net (Idx_Val);
- Off := Dyn_Index_To_Offset (Pfx_Val, Idx, Name);
- return Dyn_Bit_Extract (Pfx_Val, Off, Name);
+ Off := Dyn_Index_To_Offset
+ (Pfx_Val.Typ.Abounds.D (1), Idx_Val, Name);
+ El_Width := Get_Type_Width (Pfx_Val.Typ.Arr_El);
+ Res := Build_Dyn_Extract
+ (Build_Context, Get_Net (Pfx_Val), Off, El_Width, 0, El_Width);
+ Set_Location (Res, Name);
+ return Create_Value_Net (Res, Pfx_Val.Typ.Arr_El);
end;
+ else
+ raise Internal_Error;
end if;
end Synth_Indexed_Name;
@@ -1302,7 +1340,7 @@ package body Synth.Expr is
-- Identify LEFT to/downto RIGHT as:
-- INP * STEP + WIDTH - 1 + OFF to/downto INP * STEP + OFF
procedure Synth_Extract_Dyn_Suffix (Loc : Node;
- Pfx_Bnd : Type_Acc;
+ Pfx_Bnd : Bound_Type;
Left : Net;
Right : Net;
Inp : out Net;
@@ -1346,20 +1384,20 @@ package body Synth.Expr is
-- FIXME: what to do with negative values.
Step := Uns32 (L_Fac);
- case Pfx_Bnd.Vbound.Dir is
+ case Pfx_Bnd.Dir is
when Iir_To =>
- Off := L_Add - Pfx_Bnd.Vbound.Left;
+ Off := L_Add - Pfx_Bnd.Left;
Width := Uns32 (R_Add - L_Add + 1);
when Iir_Downto =>
- Off := R_Add - Pfx_Bnd.Vbound.Right;
+ Off := R_Add - Pfx_Bnd.Right;
Width := Uns32 (L_Add - R_Add + 1);
end case;
end Synth_Extract_Dyn_Suffix;
procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
Name : Node;
- Pfx_Bnd : Type_Acc;
- Res_Bnd : out Type_Acc;
+ Pfx_Bnd : Bound_Type;
+ Res_Bnd : out Bound_Type;
Inp : out Net;
Step : out Uns32;
Off : out Int32;
@@ -1369,7 +1407,6 @@ package body Synth.Expr is
Left, Right : Value_Acc;
Dir : Iir_Direction;
begin
- Res_Bnd := null;
Off := 0;
case Get_Kind (Expr) is
@@ -1381,7 +1418,7 @@ package body Synth.Expr is
Error_Msg_Synth (+Expr, "only range supported for slices");
end case;
- if Pfx_Bnd.Vbound.Dir /= Dir then
+ if Pfx_Bnd.Dir /= Dir then
Error_Msg_Synth (+Name, "direction mismatch in slice");
Step := 0;
Wd := 0;
@@ -1402,8 +1439,8 @@ package body Synth.Expr is
Inp := No_Net;
Step := 0;
- if not In_Bounds (Pfx_Bnd.Vbound, Int32 (Left.Scal))
- or else not In_Bounds (Pfx_Bnd.Vbound, Int32 (Right.Scal))
+ if not In_Bounds (Pfx_Bnd, Int32 (Left.Scal))
+ or else not In_Bounds (Pfx_Bnd, Int32 (Right.Scal))
then
Error_Msg_Synth (+Name, "index not within bounds");
Wd := 0;
@@ -1411,27 +1448,25 @@ package body Synth.Expr is
return;
end if;
- case Pfx_Bnd.Vbound.Dir is
+ case Pfx_Bnd.Dir is
when Iir_To =>
Wd := Width (Right.Scal - Left.Scal + 1);
- Res_Bnd := Create_Vector_Type
- (Bound_Type'(Dir => Iir_To,
- W => Wd,
- Len => Wd,
- Left => Int32 (Left.Scal),
- Right => Int32 (Right.Scal)),
- Pfx_Bnd.Vec_El);
- Off := Pfx_Bnd.Vbound.Right - Res_Bnd.Vbound.Right;
+ Res_Bnd := (Dir => Iir_To,
+ Wlen => Wd,
+ Wbounds => Wd,
+ Len => Wd,
+ Left => Int32 (Left.Scal),
+ Right => Int32 (Right.Scal));
+ Off := Pfx_Bnd.Right - Res_Bnd.Right;
when Iir_Downto =>
Wd := Width (Left.Scal - Right.Scal + 1);
- Res_Bnd := Create_Vector_Type
- (Bound_Type'(Dir => Iir_Downto,
- W => Wd,
- Len => Wd,
- Left => Int32 (Left.Scal),
- Right => Int32 (Right.Scal)),
- Pfx_Bnd.Vec_El);
- Off := Res_Bnd.Vbound.Right - Pfx_Bnd.Vbound.Right;
+ Res_Bnd := (Dir => Iir_Downto,
+ Wlen => Wd,
+ Wbounds => Wd,
+ Len => Wd,
+ Left => Int32 (Left.Scal),
+ Right => Int32 (Right.Scal));
+ Off := Res_Bnd.Right - Pfx_Bnd.Right;
end case;
end if;
end Synth_Slice_Suffix;
@@ -1441,24 +1476,27 @@ package body Synth.Expr is
is
Pfx_Node : constant Node := Get_Prefix (Name);
Pfx : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx_Node);
- Bnd : constant Type_Acc := Pfx.Typ;
- Res_Bnd : Type_Acc;
+ Res_Bnd : Bound_Type;
+ Res_Type : Type_Acc;
Inp : Net;
Step : Uns32;
Off : Int32;
Wd : Uns32;
N : Net;
begin
- Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Inp, Step, Off, Wd);
+ Synth_Slice_Suffix
+ (Syn_Inst, Name, Pfx.Typ.Vbound, Res_Bnd, Inp, Step, Off, Wd);
if Inp /= No_Net then
N := Build_Dyn_Extract (Build_Context, Get_Net (Pfx),
Inp, Step, Off, Wd);
Set_Location (N, Name);
+ -- TODO: the bounds cannot be created as they are not known.
return Create_Value_Net (N, null);
else
N := Build_Extract (Build_Context, Get_Net (Pfx), Uns32 (Off), Wd);
Set_Location (N, Name);
- return Create_Value_Net (N, Res_Bnd);
+ Res_Type := Create_Vector_Type (Res_Bnd, Pfx.Typ.Vec_El);
+ return Create_Value_Net (N, Res_Type);
end if;
end Synth_Slice_Name;
@@ -1771,9 +1809,16 @@ package body Synth.Expr is
end;
when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat =>
-- UNSIGNED to Natural.
- return Create_Value_Net
- (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), 32),
- null);
+ declare
+ Nat_Type : constant Type_Acc :=
+ Get_Value_Type (Syn_Inst,
+ Vhdl.Std_Package.Natural_Subtype_Definition);
+ begin
+ return Create_Value_Net
+ (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)),
+ Nat_Type.Drange.W),
+ Nat_Type);
+ end;
when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat =>
declare
V : constant Value_Acc := Subprg_Inst.Objects (1);
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index f2ec51476..039dab5d6 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -74,8 +74,8 @@ package Synth.Expr is
procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
Name : Node;
- Pfx_Bnd : Type_Acc;
- Res_Bnd : out Type_Acc;
+ Pfx_Bnd : Bound_Type;
+ Res_Bnd : out Bound_Type;
Inp : out Net;
Step : out Uns32;
Off : out Int32;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 3d779f54c..468733b09 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -161,7 +161,8 @@ package body Synth.Stmts is
Pfx : constant Node := Get_Prefix (Target);
Targ : constant Value_Acc :=
Get_Value (Syn_Inst, Get_Base_Name (Pfx));
- Res_Bnd : Type_Acc;
+ Res_Bnd : Bound_Type;
+ Res_Type : Type_Acc;
Targ_Net : Net;
Inp : Net;
Step : Uns32;
@@ -174,7 +175,7 @@ package body Synth.Stmts is
-- Only support assignment of vector.
raise Internal_Error;
end if;
- Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ,
+ Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ.Vbound,
Res_Bnd, Inp, Step, Off, Wd);
Targ_Net := Get_Last_Assigned_Value (Targ.W);
V := Get_Net (Val);
@@ -186,7 +187,8 @@ package body Synth.Stmts is
(Build_Context, Targ_Net, V, Uns32 (Off));
end if;
Set_Location (Res, Target);
- Synth_Assign (Targ, Create_Value_Net (Res, Res_Bnd));
+ Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El);
+ Synth_Assign (Targ, Create_Value_Net (Res, Res_Type));
end;
when others =>
Error_Kind ("synth_assignment", Target);
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 699705977..c6b0b1ae5 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -20,6 +20,7 @@
with Ada.Unchecked_Conversion;
with System;
+with Mutils;
package body Synth.Values is
function To_Bound_Array_Acc is new Ada.Unchecked_Conversion
@@ -86,10 +87,13 @@ package body Synth.Values is
end Create_Vector_Type;
function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc)
- return Type_Acc is
+ return Type_Acc
+ is
+ W : constant Width := Uns32 (Mutils.Clog2 (Uns64 (Len)));
begin
return Create_Vector_Type ((Dir => Iir_Downto,
- W => 0,
+ Wlen => W,
+ Wbounds => W,
Left => Int32 (Len) - 1,
Right => 0,
Len => Len),
@@ -337,6 +341,16 @@ package body Synth.Values is
return Atype.Drange.W;
when Type_Vector =>
return Atype.Vbound.Len;
+ when Type_Array =>
+ declare
+ Res : Width;
+ begin
+ Res := Get_Type_Width (Atype.Arr_El);
+ for I in Atype.Abounds.D'Range loop
+ Res := Res * Atype.Abounds.D (I).Len;
+ end loop;
+ return Res;
+ end;
when others =>
raise Internal_Error;
end case;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index f754c73be..f62c2cbbf 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -30,7 +30,7 @@ package Synth.Values is
-- An integer range.
Dir : Iir_Direction;
- -- Netlist representation: signed or unsigned, width of bus.
+ -- Netlist representation: signed or unsigned, width of vector.
Is_Signed : Boolean;
W : Width;
@@ -46,10 +46,18 @@ package Synth.Values is
type Bound_Type is record
Dir : Iir_Direction;
- W : Width;
Left : Int32;
Right : Int32;
Len : Width;
+
+ -- Width of length. This is the number of address bits.
+ Wlen : Width;
+
+ -- Width of bounds. This is the precision used to compute the
+ -- address.
+ -- If bounds are 1 to 128 (so left = 1, dir = to, right = 128),
+ -- Wlen = 7 and Wbounds = 8.
+ Wbounds : Width;
end record;
type Bound_Array_Type is array (Iir_Index32 range <>) of Bound_Type;
diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads
index f44f6c4e0..a884f7b9d 100644
--- a/src/vhdl/vhdl-nodes.ads
+++ b/src/vhdl/vhdl-nodes.ads
@@ -4880,6 +4880,8 @@ package Vhdl.Nodes is
-- Numeric_Std.
-- Abbreviations:
-- Uns: Unsigned, Sgn: Signed, Nat: Natural, Int: Integer.
+
+ -- To_Integer, To_Unsigned, to_Signed
Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat,
Iir_Predefined_Ieee_Numeric_Std_Toint_Sgn_Int,
Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns,
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-04 03:25:14 +0000