diff options
| -rw-r--r-- | src/synth/netlists-builders.adb | 10 | ||||
| -rw-r--r-- | src/synth/netlists-builders.ads | 5 | ||||
| -rw-r--r-- | src/synth/synth-context.adb | 25 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 18 | ||||
| -rw-r--r-- | src/synth/synth-environment.adb | 4 | ||||
| -rw-r--r-- | src/synth/synth-environment.ads | 5 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 86 | ||||
| -rw-r--r-- | src/synth/synth-inference.adb | 9 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 194 | ||||
| -rw-r--r-- | src/synth/synth-values.adb | 59 | ||||
| -rw-r--r-- | src/synth/synth-values.ads | 21 | ||||
| -rw-r--r-- | src/synth/types_utils.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/vhdl-annotations.adb | 4 |
13 files changed, 361 insertions, 82 deletions
diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb index 2e682197e..3f79bbc9e 100644 --- a/src/synth/netlists-builders.adb +++ b/src/synth/netlists-builders.adb @@ -982,6 +982,16 @@ package body Netlists.Builders is return O; end Build_Extract; + 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; + function Build_Dyn_Extract (Ctxt : Context_Acc; I : Net; P : Net; Step : Uns32; Off : Int32; W : Width) return Net diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads index 20580aaba..8aa4501c0 100644 --- a/src/synth/netlists-builders.ads +++ b/src/synth/netlists-builders.ads @@ -94,6 +94,11 @@ package Netlists.Builders is function Build_Extract (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net; + + -- Same as Build_Extract, but return I iff extract all the bits. + function Build2_Extract + (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net; + function Build_Extract_Bit (Ctxt : Context_Acc; I : Net; Off : Width) return Net; function Build_Dyn_Extract diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 49a5e54ef..ea7e06905 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -22,6 +22,7 @@ with Ada.Unchecked_Deallocation; with Types; use Types; with Tables; +with Types_Utils; use Types_Utils; with Vhdl.Errors; use Vhdl.Errors; with Netlists.Builders; use Netlists.Builders; @@ -91,7 +92,8 @@ package body Synth.Context is when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition => + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Record_Type_Definition => Otype := Get_Value_Type (Syn_Inst, Obj_Type); return Alloc_Wire (Kind, Obj, Otype); when others => @@ -283,6 +285,19 @@ package body Synth.Context is Vec (Idx).Zx := Vec (Idx).Zx or Zx; Off := Off + 1; end; + when Type_Discrete => + for I in reverse 0 .. Val.Typ.Drange.W - 1 loop + declare + B : constant Uns32 := + Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I))) + and 1; + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + begin + Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos); + end; + Off := Off + 1; + end loop; when Type_Vector => -- TODO: optimize off mod 32 = 0. for I in reverse Val.Arr.V'Range loop @@ -292,6 +307,10 @@ package body Synth.Context is for I in reverse Val.Arr.V'Range loop Value2net (Val.Arr.V (I), Vec, Off, Has_Zx); end loop; + when Type_Record => + for I in Val.Rec.V'Range loop + Value2net (Val.Rec.V (I), Vec, Off, Has_Zx); + end loop; when others => raise Internal_Error; end case; @@ -364,13 +383,15 @@ package body Synth.Context is else raise Internal_Error; end if; - when Value_Array => + when Value_Array + | Value_Record => 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 + -- TODO: Alloc on the heap. raise Internal_Error; else declare diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 31540cf7d..691c32aa1 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -118,15 +118,32 @@ package body Synth.Decls is | Iir_Kind_File_Type_Definition => null; when Iir_Kind_Record_Type_Definition => + if not Is_Fully_Constrained_Type (Def) then + return; + end if; declare El_List : constant Node_Flist := Get_Elements_Declaration_List (Def); + Rec_Els : Rec_El_Array_Acc; El : Node; + El_Typ : Type_Acc; + Off : Uns32; begin + Rec_Els := Create_Rec_El_Array + (Iir_Index32 (Get_Nbr_Elements (El_List))); + Typ := Create_Record_Type (Rec_Els, 0); + Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + + Off := 0; for I in Flist_First .. Flist_Last (El_List) loop El := Get_Nth_Element (El_List, I); Synth_Declaration_Type (Syn_Inst, El); + El_Typ := Get_Value_Type (Syn_Inst, Get_Type (El)); + Rec_Els.E (Iir_Index32 (I + 1)) := (Off => Off, + Typ => El_Typ); + Off := Off + Get_Type_Width (El_Typ); end loop; + Typ.Rec_W := Off; end; when others => Error_Kind ("synth_type_definition", Def); @@ -394,7 +411,6 @@ package body Synth.Decls is end loop; end Synth_Attribute_Specification; - procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is begin case Get_Kind (Decl) is diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index 1ae10f951..8b236f310 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -27,10 +27,6 @@ with Vhdl.Nodes; with Vhdl.Errors; use Vhdl.Errors; package body Synth.Environment is - function Get_Current_Assign_Value - (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width) - return Net; - procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True) is begin Wire_Id_Table.Table (Wid).Mark_Flag := Mark; diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index 604991dd5..6b817ff00 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -73,6 +73,11 @@ package Synth.Environment is function Get_Last_Assigned_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id) return Net; + function Get_Current_Assign_Value + (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width) + return Net; + + -- Read and write the mark flag. function Get_Wire_Mark (Wid : Wire_Id) return Boolean; procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 063257008..7bdad0672 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -257,6 +257,7 @@ package body Synth.Expr is Idx_Type : constant Node := Get_Index_Type (Aggr_Type, Dim); type Boolean_Array is array (Uns32 range <>) of Boolean; pragma Pack (Boolean_Array); + -- FIXME: test Res.Arr.V (I) instead. Is_Set : Boolean_Array (0 .. Bound.Len - 1); Value : Node; Assoc : Node; @@ -336,6 +337,55 @@ package body Synth.Expr is end loop; end Fill_Array_Aggregate; + procedure Fill_Record_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Res : Value_Acc) + is + El_List : constant Node_Flist := + Get_Elements_Declaration_List (Get_Type (Aggr)); + Value : Node; + Assoc : Node; + Pos : Natural; + + procedure Set_Elem (Pos : Natural) + is + Val : Value_Acc; + begin + Val := Synth_Expression_With_Type + (Syn_Inst, Value, Get_Type (Get_Nth_Element (El_List, Pos))); + Res.Rec.V (Iir_Index32 (Pos + 1)) := Val; + end Set_Elem; + begin + Assoc := Get_Association_Choices_Chain (Aggr); + Pos := 0; + Res.Rec.V := (others => null); + while Is_Valid (Assoc) loop + Value := Get_Associated_Expr (Assoc); + loop + case Get_Kind (Assoc) is + when Iir_Kind_Choice_By_None => + Set_Elem (Pos); + Pos := Pos + 1; + when Iir_Kind_Choice_By_Others => + for I in Res.Rec.V'Range loop + if Res.Rec.V (I) = null then + Set_Elem (Natural (I - 1)); + end if; + end loop; + when Iir_Kind_Choice_By_Name => + Pos := Natural (Get_Element_Position (Get_Name (Assoc))); + Set_Elem (Pos); + when others => + Error_Msg_Synth + (+Assoc, "unhandled association form"); + end case; + Assoc := Get_Chain (Assoc); + exit when Is_Null (Assoc); + exit when not Get_Same_Alternative_Flag (Assoc); + end loop; + end loop; + end Fill_Record_Aggregate; + procedure Concat_Array (Arr : in out Net_Array) is Last : Int32; @@ -635,13 +685,29 @@ package body Synth.Expr is Fill_Array_Aggregate (Syn_Inst, Aggr, Res, 0); - if Is_Vector_Type (Aggr_Type) then + if False and Is_Vector_Type (Aggr_Type) then Res := Vectorize_Array (Res, Get_Element_Subtype (Aggr_Type)); end if; return Res; end Synth_Aggregate_Array; + function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Aggr_Type : Node) return Value_Acc + is + Res_Type : Type_Acc; + Res : Value_Acc; + begin + -- Allocate the result. + Res_Type := Get_Value_Type (Syn_Inst, Aggr_Type); + Res := Create_Value_Record (Res_Type); + + Fill_Record_Aggregate (Syn_Inst, Aggr, Res); + + return Res; + end Synth_Aggregate_Record; + -- Aggr_Type is the type from the context. function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node; @@ -654,7 +720,7 @@ package body Synth.Expr is return Synth_Aggregate_Array (Syn_Inst, Aggr, Aggr_Type); when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => - raise Internal_Error; + return Synth_Aggregate_Record (Syn_Inst, Aggr, Aggr_Type); when others => Error_Kind ("synth_aggregate", Aggr_Type); end case; @@ -2178,6 +2244,22 @@ package body Synth.Expr is return Synth_Indexed_Name (Syn_Inst, Expr); when Iir_Kind_Slice_Name => return Synth_Slice_Name (Syn_Inst, Expr); + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Expr)); + Pfx : constant Node := Get_Prefix (Expr); + Res_Typ : Type_Acc; + N : Net; + begin + Res := Synth_Expression (Syn_Inst, Pfx); + Res_Typ := Res.Typ.Rec.E (Idx + 1).Typ; + -- FIXME: handle const. + N := Build_Extract + (Build_Context, Get_Net (Res), + Res.Typ.Rec.E (Idx + 1).Off, Get_Type_Width (Res_Typ)); + return Create_Value_Net (N, Res_Typ); + end; when Iir_Kind_Character_Literal => return Synth_Expression_With_Type (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); diff --git a/src/synth/synth-inference.adb b/src/synth/synth-inference.adb index 8ff6dc1a6..5017a2726 100644 --- a/src/synth/synth-inference.adb +++ b/src/synth/synth-inference.adb @@ -215,7 +215,6 @@ package body Synth.Inference is Res : Net; Sig : Instance; Init : Net; - Init_Input : Input; Rst : Net; Rst_Val : Net; begin @@ -238,13 +237,11 @@ package body Synth.Inference is Data := Build_Mux2 (Ctxt, Enable, Prev_Val, Data); end if; - -- If the signal declaration has an initial value, move it - -- to the dff. + -- If the signal declaration has an initial value, get it. Sig := Get_Parent (Prev_Val); if Get_Id (Get_Module (Sig)) = Id_Isignal then - Init_Input := Get_Input (Sig, 1); - Init := Get_Driver (Init_Input); - Disconnect (Init_Input); + Init := Get_Input_Net (Sig, 1); + Init := Build2_Extract (Ctxt, Init, Off, Get_Width (O)); else Init := No_Net; end if; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index b16952d17..1a3805c77 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -76,14 +76,14 @@ package body Synth.Stmts is end if; end Synth_Waveform; - procedure Synth_Assign (Dest : Value_Acc; + procedure Synth_Assign (Wid : Wire_Id; + Typ : Type_Acc; Val : Value_Acc; Offset : Uns32; Loc : Source.Syn_Src) is begin - pragma Assert (Dest.Kind = Value_Wire); - Phi_Assign (Build_Context, Dest.W, - Get_Net (Synth_Subtype_Conversion (Val, Dest.Typ, Loc)), + Phi_Assign (Build_Context, Wid, + Get_Net (Synth_Subtype_Conversion (Val, Typ, Loc)), Offset); end Synth_Assign; @@ -119,39 +119,68 @@ package body Synth.Stmts is end if; end Synth_Assignment_Aggregate; - procedure Synth_Indexed_Assignment (Syn_Inst : Synth_Instance_Acc; - Target : Node; - Val : Value_Acc; - Loc : Node) - 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; + procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Pfx : Node; + Loc : Node; + Dest_Wid : out Wire_Id; + Dest_Off : out Uns32; + Dest_Type : out Type_Acc) is begin - Synth_Indexed_Name (Syn_Inst, Target, Targ.Typ, Voff, Mul, Off, W); + case Get_Kind (Pfx) is + when Iir_Kind_Simple_Name => + Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), Loc, + Dest_Wid, Dest_Off, Dest_Type); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Anonymous_Signal_Declaration => + declare + Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx); + begin + Dest_Wid := Targ.W; + Dest_Off := 0; + Dest_Type := Targ.Typ; + end; + when Iir_Kind_Indexed_Name => + declare + Voff : Net; + Mul : Uns32; + Off : Uns32; + W : Width; + begin + Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Loc, + Dest_Wid, Dest_Off, Dest_Type); + Synth_Indexed_Name + (Syn_Inst, Pfx, Dest_Type, Voff, Mul, Off, W); + + if Voff /= No_Net then + Error_Msg_Synth + (+Pfx, "dynamic index must be the last suffix"); + return; + end if; - pragma Assert (Get_Type_Width (Val.Typ) = W); + -- FIXME: check index. - if Voff = No_Net then - -- FIXME: check index. - pragma Assert (Mul = 0); - Synth_Assign (Targ, Val, Off, Loc); - else - Targ_Net := Get_Last_Assigned_Value (Build_Context, Targ.W); - Val_Net := Get_Net (Val); - V := Build_Dyn_Insert - (Build_Context, Targ_Net, Val_Net, Voff, Mul, Int32 (Off)); - Set_Location (V, Target); - Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ), 0, Loc); - end if; - end Synth_Indexed_Assignment; + pragma Assert (Mul = 0); + Dest_Off := Dest_Off + Off; + Dest_Type := Get_Array_Element (Dest_Type); + end; + + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Pfx)); + begin + Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Loc, + Dest_Wid, Dest_Off, Dest_Type); + Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off; + Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ; + end; + + when others => + Error_Kind ("synth_assignment_prefix", Pfx); + end case; + end Synth_Assignment_Prefix; procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; @@ -159,49 +188,90 @@ package body Synth.Stmts is Loc : Node) is begin case Get_Kind (Target) is - when Iir_Kind_Simple_Name => - Synth_Assignment (Syn_Inst, Get_Named_Entity (Target), Val, Loc); - when Iir_Kind_Interface_Signal_Declaration + when Iir_Kind_Aggregate => + Synth_Assignment_Aggregate (Syn_Inst, Target, Val, Loc); + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => - Synth_Assign (Get_Value (Syn_Inst, Target), Val, 0, Loc); - when Iir_Kind_Aggregate => - Synth_Assignment_Aggregate (Syn_Inst, Target, Val, Loc); + declare + Wid : Wire_Id; + Off : Uns32; + Typ : Type_Acc; + begin + Synth_Assignment_Prefix (Syn_Inst, Target, Loc, Wid, Off, Typ); + Synth_Assign (Wid, Typ, Val, Off, Loc); + end; when Iir_Kind_Indexed_Name => - Synth_Indexed_Assignment (Syn_Inst, Target, Val, Loc); + declare + Wid : Wire_Id; + Off : Uns32; + Typ : Type_Acc; + + Voff : Net; + Mul : Uns32; + Idx_Off : Uns32; + W : Width; + + Targ_Net : Net; + V : Net; + begin + Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Target), Loc, + Wid, Off, Typ); + Synth_Indexed_Name (Syn_Inst, Target, Typ, + Voff, Mul, Idx_Off, W); + + if Voff = No_Net then + -- FIXME: check index. + pragma Assert (Mul = 0); + Synth_Assign (Wid, Get_Array_Element (Typ), + Val, Off + Idx_Off, Loc); + else + Targ_Net := Get_Current_Assign_Value + (Build_Context, Wid, Off, Get_Type_Width (Typ)); + V := Build_Dyn_Insert + (Build_Context, Targ_Net, Get_Net (Val), + Voff, Mul, Int32 (Idx_Off)); + Set_Location (V, Target); + Synth_Assign (Wid, Typ, Create_Value_Net (V, Typ), Off, Loc); + end if; + end; when Iir_Kind_Slice_Name => declare - Pfx : constant Node := Get_Prefix (Target); - Targ : constant Value_Acc := - Get_Value (Syn_Inst, Get_Base_Name (Pfx)); + Wid : Wire_Id; + Off : Uns32; + Typ : Type_Acc; + Res_Bnd : Bound_Type; - Res_Type : Type_Acc; - Targ_Net : Net; Inp : Net; Step : Uns32; - Off : Int32; + Sl_Off : Int32; Wd : Uns32; + + Targ_Net : Net; + Res_Type : Type_Acc; V : Net; - Res : Net; begin - if Targ.Kind /= Value_Wire then - -- Only support assignment of vector. - raise Internal_Error; - end if; - Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ.Vbound, - Res_Bnd, Inp, Step, Off, Wd); + Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Target), Loc, + Wid, Off, Typ); + Synth_Slice_Suffix (Syn_Inst, Target, Typ.Vbound, + Res_Bnd, Inp, Step, Sl_Off, Wd); + if Inp /= No_Net then - Targ_Net := Get_Last_Assigned_Value (Build_Context, Targ.W); - V := Get_Net (Val); - Res := Build_Dyn_Insert - (Build_Context, Targ_Net, V, Inp, Step, Off); - Set_Location (Res, Target); - Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El); + Targ_Net := Get_Current_Assign_Value + (Build_Context, Wid, Off, Get_Type_Width (Typ)); + V := Build_Dyn_Insert + (Build_Context, Targ_Net, Get_Net (Val), + Inp, Step, Sl_Off); + Set_Location (V, Target); + Res_Type := Create_Vector_Type (Res_Bnd, Typ.Vec_El); Synth_Assign - (Targ, Create_Value_Net (Res, Res_Type), 0, Loc); + (Wid, Res_Type, Create_Value_Net (V, Res_Type), Off, Loc); else - Synth_Assign (Targ, Val, Uns32 (Off), Loc); + -- FIXME: create slice type. + Synth_Assign (Wid, Typ, Val, Off + Uns32 (Sl_Off), Loc); end if; end; when others => diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index fe0785023..750b0c5e1 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -26,6 +26,9 @@ package body Synth.Values is function To_Bound_Array_Acc is new Ada.Unchecked_Conversion (System.Address, Bound_Array_Acc); + function To_Rec_El_Array_Acc is new Ada.Unchecked_Conversion + (System.Address, Rec_El_Array_Acc); + function To_Type_Acc is new Ada.Unchecked_Conversion (System.Address, Type_Acc); @@ -161,6 +164,44 @@ package body Synth.Values is end case; end Get_Array_Element; + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc + is + use System; + subtype Data_Type is Rec_El_Array (Nels); + Res : Address; + begin + -- Manually allocate the array to handle large arrays without + -- creating a large temporary value. + Areapools.Allocate + (Current_Pool.all, Res, + Data_Type'Size / Storage_Unit, Data_Type'Alignment); + + declare + -- Discard the warnings for no pragma Import as we really want + -- to use the default initialization. + pragma Warnings (Off); + Addr1 : constant Address := Res; + Init : Data_Type; + for Init'Address use Addr1; + pragma Warnings (On); + begin + null; + end; + + return To_Rec_El_Array_Acc (Res); + end Create_Rec_El_Array; + + function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width) + return Type_Acc + is + subtype Record_Type_Type is Type_Type (Type_Record); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, + Rec_W => W, + Rec => Els))); + end Create_Record_Type; + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc is subtype Value_Type_Wire is Value_Type (Values.Value_Wire); @@ -293,6 +334,22 @@ package body Synth.Values is return Res; end Create_Value_Array; + function Create_Value_Record (Typ : Type_Acc) return Value_Acc + is + subtype Value_Type_Record is Value_Type (Value_Record); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Record); + + Res : Value_Acc; + Rec_El : Value_Array_Acc; + begin + Rec_El := Create_Value_Array (Typ.Rec.Len); + Res := To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Record, + Typ => Typ, + Rec => Rec_El))); + return Res; + end Create_Value_Record; + function Create_Value_Instance (Inst : Instance_Id) return Value_Acc is subtype Value_Type_Instance is Value_Type (Value_Instance); @@ -356,6 +413,8 @@ package body Synth.Values is end loop; return Res; end; + when Type_Record => + return Atype.Rec_W; when others => raise Internal_Error; end case; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index f62c2cbbf..09718bd80 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -82,13 +82,17 @@ package Synth.Values is type Type_Type (Kind : Type_Kind); type Type_Acc is access Type_Type; - type Type_Acc_Array_Type is array (Iir_Index32 range <>) of Type_Acc; + type Rec_El_Type is record + Off : Uns32; + Typ : Type_Acc; + end record; - type Type_Acc_Array (Len : Iir_Index32) is record - E : Type_Acc_Array_Type (1 .. Len); + type Rec_El_Array_Type is array (Iir_Index32 range <>) of Rec_El_Type; + type Rec_El_Array (Len : Iir_Index32) is record + E : Rec_El_Array_Type (1 .. Len); end record; - type Type_Acc_Array_Acc is access Type_Acc_Array; + type Rec_El_Array_Acc is access Rec_El_Array; type Type_Type (Kind : Type_Kind) is record case Kind is @@ -107,7 +111,8 @@ package Synth.Values is when Type_Unbounded_Array => Uarr_El : Type_Acc; when Type_Record => - Rec : Type_Acc_Array_Acc; + Rec_W : Width; + Rec : Rec_El_Array_Acc; end case; end record; @@ -205,6 +210,10 @@ package Synth.Values is function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) return Type_Acc; function Create_Unbounded_Array (El_Type : Type_Acc) return Type_Acc; + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; + + function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width) + return Type_Acc; -- Return the element of a vector/array/unbounded_array. function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc; @@ -240,6 +249,8 @@ package Synth.Values is -- Allocate the ARR component of the Value_Type ARR, using BOUNDS. procedure Create_Array_Data (Arr : Value_Acc); + function Create_Value_Record (Typ : Type_Acc) return Value_Acc; + function Create_Value_Instance (Inst : Instance_Id) return Value_Acc; function Unshare (Src : Value_Acc; Pool : Areapool_Acc) diff --git a/src/synth/types_utils.ads b/src/synth/types_utils.ads index 27245e7d5..d89d9e58a 100644 --- a/src/synth/types_utils.ads +++ b/src/synth/types_utils.ads @@ -26,4 +26,7 @@ package Types_Utils is function To_Uns32 is new Ada.Unchecked_Conversion (Int32, Uns32); + + function To_Uns64 is new Ada.Unchecked_Conversion + (Int64, Uns64); end Types_Utils; diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb index 1e3b00043..d81e70adf 100644 --- a/src/vhdl/vhdl-annotations.adb +++ b/src/vhdl/vhdl-annotations.adb @@ -410,6 +410,10 @@ package body Vhdl.Annotations is end if; when Iir_Kind_Record_Type_Definition => + if Flag_Synthesis then + -- For the offsets. + Create_Object_Info (Block_Info, Def, Kind_Type); + end if; declare List : constant Iir_Flist := Get_Elements_Declaration_List (Def); |