diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-07-30 07:29:10 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-07-30 08:29:15 +0200 |
commit | 59fda76c701948c840c7e60d352ed8abb7699955 (patch) | |
tree | 24b12a969e374d629550375e4e13c669d5d3ad69 /src | |
parent | 3dcf90fdee4286d5852604df417a5b6e75382265 (diff) | |
download | ghdl-59fda76c701948c840c7e60d352ed8abb7699955.tar.gz ghdl-59fda76c701948c840c7e60d352ed8abb7699955.tar.bz2 ghdl-59fda76c701948c840c7e60d352ed8abb7699955.zip |
synth: rework indexed names.
Diffstat (limited to 'src')
-rw-r--r-- | src/synth/synth-context.adb | 25 | ||||
-rw-r--r-- | src/synth/synth-expr.adb | 102 | ||||
-rw-r--r-- | src/synth/synth-expr.ads | 10 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 70 |
4 files changed, 106 insertions, 101 deletions
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 7681d8f3b..be229c4cd 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -25,7 +25,6 @@ with Tables; with Vhdl.Errors; use Vhdl.Errors; with Netlists.Builders; use Netlists.Builders; -with Synth.Types; use Synth.Types; with Synth.Errors; use Synth.Errors; with Synth.Expr; use Synth.Expr; @@ -90,27 +89,11 @@ package body Synth.Context is begin case Get_Kind (Obj_Type) is when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - Otype := Get_Value_Type (Syn_Inst, Get_Type (Obj)); + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition => + Otype := Get_Value_Type (Syn_Inst, Obj_Type); return Alloc_Wire (Kind, Obj, Otype); - when Iir_Kind_Array_Subtype_Definition => - declare - Bnd : Value_Acc; - begin - Bnd := Get_Value (Syn_Inst, Obj_Type); - if Is_Vector_Type (Obj_Type) then - return Alloc_Wire (Kind, Obj, Bnd.Typ); - else - raise Internal_Error; - end if; - end; - when Iir_Kind_Integer_Subtype_Definition => - declare - Rng : Value_Acc; - begin - Rng := Get_Value (Syn_Inst, Obj_Type); - return Alloc_Wire (Kind, Obj, Rng.Typ); - end; when others => Error_Kind ("alloc_object", Obj_Type); end case; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index abdedf37b..10173471f 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -1130,22 +1130,20 @@ package body Synth.Expr is end case; end In_Bounds; - function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node) - return Uns32 - is - Rng : constant Type_Acc := Pfx.Typ; + function Index_To_Offset (Bnd : Bound_Type; Idx : Int64; Loc : Node) + return Uns32 is begin - if not In_Bounds (Rng.Vbound, Int32 (Idx)) then + if not In_Bounds (Bnd, Int32 (Idx)) then Error_Msg_Synth (+Loc, "index not within bounds"); return 0; end if; -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. - case Rng.Vbound.Dir is + case Bnd.Dir is when Iir_To => - return Uns32 (Rng.Vbound.Right - Int32 (Idx)); + return Uns32 (Bnd.Right - Int32 (Idx)); when Iir_Downto => - return Uns32 (Int32 (Idx) - Rng.Vbound.Right); + return Uns32 (Int32 (Idx) - Bnd.Right); end case; end Index_To_Offset; @@ -1175,64 +1173,78 @@ package body Synth.Expr is return Off; end Dyn_Index_To_Offset; - function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) - return Value_Acc + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + Voff : out Net; + Mul : out Uns32; + Off : out Uns32; + W : out Width) is 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 yet supported"); - return null; + raise Internal_Error; 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 Pfx_Val.Typ.Kind = Type_Vector then + if Pfx_Type.Kind = Type_Vector then + W := 1; + Mul := 0; 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; + Voff := No_Net; + Off := Index_To_Offset (Pfx_Type.Vbound, Idx_Val.Scal, Name); 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; + Voff := Dyn_Index_To_Offset (Pfx_Type.Vbound, Idx_Val, Name); + Off := 0; end if; - elsif Pfx_Val.Typ.Kind = Type_Array then - declare - Off : Net; - Res : Net; - El_Width : Width; - begin - 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; + elsif Pfx_Type.Kind = Type_Array then + Voff := Dyn_Index_To_Offset (Pfx_Type.Abounds.D (1), Idx_Val, Name); + W := Get_Type_Width (Pfx_Type.Arr_El); + Mul := W; + Off := 0; else raise Internal_Error; end if; end Synth_Indexed_Name; + function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Value_Acc + is + Pfx_Val : Value_Acc; + Voff : Net; + Mul : Uns32; + Off : Uns32; + W : Width; + Res : Net; + begin + Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); + + Synth_Indexed_Name (Syn_Inst, Name, Pfx_Val.Typ, Voff, Mul, Off, W); + + if Voff = No_Net then + pragma Assert (Mul = 0); + if W = 1 and then Pfx_Val.Kind = Value_Array then + return Bit_Extract (Pfx_Val, Off, Name); + else + Res := Build_Extract (Build_Context, Get_Net (Pfx_Val), Off, W); + Set_Location (Res, Name); + return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ)); + end if; + else + Res := Build_Dyn_Extract + (Build_Context, Get_Net (Pfx_Val), Voff, Mul, Int32 (Off), W); + Set_Location (Res, Name); + return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ)); + end if; + end Synth_Indexed_Name; + function Is_Const (N : Net) return Boolean is begin case Get_Id (Get_Module (Get_Parent (N))) is diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 039dab5d6..f7edc2417 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -69,7 +69,7 @@ package Synth.Expr is (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type; -- Convert index IDX in PFX to an offset. LOC is used in case of error. - function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node) + function Index_To_Offset (Bnd : Bound_Type; Idx : Int64; Loc : Node) return Uns32; procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; @@ -80,4 +80,12 @@ package Synth.Expr is Step : out Uns32; Off : out Int32; Wd : out Uns32); + + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + Voff : out Net; + Mul : out Uns32; + Off : out Uns32; + W : out Width); end Synth.Expr; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 468733b09..888746ae7 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -110,9 +110,41 @@ package body Synth.Stmts is end if; end Synth_Assignment_Aggregate; - procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; - Target : Node; - Val : Value_Acc) is + procedure Synth_Indexed_Assignment + (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) + is + Pfx : constant Node := Get_Prefix (Target); + Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); + Targ_Net : Net; + V : Net; + + Val_Net : Net; + Voff : Net; + Mul : Uns32; + Off : Uns32; + W : Width; + begin + Synth_Indexed_Name (Syn_Inst, Target, Targ.Typ, Voff, Mul, Off, W); + + pragma Assert (Get_Type_Width (Val.Typ) = W); + Targ_Net := Get_Last_Assigned_Value (Targ.W); + Val_Net := Get_Net (Val); + + if Voff = No_Net then + -- FIXME: check index. + pragma Assert (Mul = 0); + V := Build_Insert (Build_Context, Targ_Net, Val_Net, Off); + Set_Location (V, Target); + else + V := Build_Dyn_Insert + (Build_Context, Targ_Net, Val_Net, Voff, Mul, Int32 (Off)); + Set_Location (V, Target); + end if; + Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ)); + end Synth_Indexed_Assignment; + + procedure Synth_Assignment + (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) is begin case Get_Kind (Target) is when Iir_Kind_Simple_Name => @@ -125,37 +157,7 @@ package body Synth.Stmts is when Iir_Kind_Aggregate => Synth_Assignment_Aggregate (Syn_Inst, Target, Val); when Iir_Kind_Indexed_Name => - declare - Pfx : constant Node := Get_Prefix (Target); - Targ : constant Value_Acc := - Get_Value (Syn_Inst, Get_Base_Name (Pfx)); - Indexes : constant Node_Flist := Get_Index_List (Target); - N_Idx : Node; - Idx : Value_Acc; - Targ_Net : Net; - V : Net; - begin - if Get_Nbr_Elements (Indexes) /= 1 - or else Targ.Kind /= Value_Wire - then - -- Only support assignment of vector. - raise Internal_Error; - end if; - N_Idx := Get_Nth_Element (Indexes, 0); - Idx := Synth_Expression_With_Type - (Syn_Inst, N_Idx, Get_Type (N_Idx)); - if Is_Const (Idx) then - -- FIXME: check index. - Targ_Net := Get_Last_Assigned_Value (Targ.W); - V := Build_Insert (Build_Context, - Targ_Net, Get_Net (Val), - Index_To_Offset (Targ, Idx.Scal, Target)); - Set_Location (V, Target); - else - raise Internal_Error; - end if; - Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ)); - end; + Synth_Indexed_Assignment (Syn_Inst, Target, Val); when Iir_Kind_Slice_Name => declare Pfx : constant Node := Get_Prefix (Target); |