From 013c41bf28a636e32d7b62e89293f4ff172a5491 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 2 Apr 2020 08:20:42 +0200 Subject: synth: more cleanup (and use of valtyp). --- src/synth/synth-context.adb | 83 ++++---------- src/synth/synth-context.ads | 1 - src/synth/synth-decls.adb | 17 +-- src/synth/synth-expr.adb | 72 ++++++------ src/synth/synth-expr.ads | 4 +- src/synth/synth-files_operations.adb | 10 +- src/synth/synth-heap.adb | 12 +- src/synth/synth-insts.adb | 30 ++--- src/synth/synth-oper.adb | 6 +- src/synth/synth-static_oper.adb | 65 +++++------ src/synth/synth-stmts.adb | 215 ++++++++++++++++++----------------- src/synth/synth-stmts.ads | 14 ++- src/synth/synth-values.adb | 187 +++++++++++++++--------------- src/synth/synth-values.ads | 33 +++--- 14 files changed, 358 insertions(+), 391 deletions(-) (limited to 'src/synth') diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index f7bbb477a..9654ec02f 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -319,7 +319,7 @@ package body Synth.Context is is Obj_Type : constant Node := Get_Type (Obj); Otyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Obj_Type); - Val : Value_Acc; + Val : Valtyp; Wid : Wire_Id; begin if Kind = Wire_None then @@ -329,7 +329,7 @@ package body Synth.Context is end if; Val := Create_Value_Wire (Wid, Otyp); - Create_Object (Syn_Inst, Obj, (Otyp, Val)); + Create_Object (Syn_Inst, Obj, Val); end Create_Wire_Object; function Get_Instance_By_Scope @@ -407,36 +407,6 @@ package body Synth.Context is return Obj_Inst.Objects (Info.Slot).T_Typ; end Get_Subtype_Object; - 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); - -- Set Is_0 to True iff VEC is 000... -- Set Is_X to True iff VEC is XXX... procedure Is_Full (Vec : Logvec_Array; @@ -468,7 +438,7 @@ package body Synth.Context is end Is_Full; procedure Value2net - (Val : Value_Acc; W : Width; Vec : in out Logvec_Array; Res : out Net) + (Val : Valtyp; W : Width; Vec : in out Logvec_Array; Res : out Net) is Off : Uns32; Has_Zx : Boolean; @@ -513,13 +483,13 @@ package body Synth.Context is end if; end Value2net; - function Get_Net (Val : Value_Acc) return Net is + function Get_Net (Val : Valtyp) return Net is begin - case Val.Kind is + case Val.Val.Kind is when Value_Wire => - return Get_Current_Value (Build_Context, Val.W); + return Get_Current_Value (Build_Context, Val.Val.W); when Value_Net => - return Val.N; + return Val.Val.N; when Value_Discrete => case Val.Typ.Kind is when Type_Bit @@ -537,7 +507,7 @@ package body Synth.Context is Sh : constant Natural := 64 - Natural (Val.Typ.W); V : Uns64; begin - V := To_Uns64 (Val.Scal); + V := To_Uns64 (Val.Val.Scal); -- Keep only Val.Typ.W bits of the value. V := Shift_Right (Shift_Left (V, Sh), Sh); return Build2_Const_Uns @@ -577,11 +547,12 @@ package body Synth.Context is when Value_Array => declare use Netlists.Concats; + El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ); C : Concat_Type; Res : Net; begin - for I in reverse Val.Arr.V'Range loop - Append (C, Get_Net (Val.Arr.V (I))); + for I in reverse Val.Val.Arr.V'Range loop + Append (C, Get_Net ((El_Typ, Val.Val.Arr.V (I)))); end loop; Build (Build_Context, C, Res); return Res; @@ -592,8 +563,9 @@ package body Synth.Context is C : Concat_Type; Res : Net; begin - for I in Val.Rec.V'Range loop - Append (C, Get_Net (Val.Rec.V (I))); + for I in Val.Typ.Rec.E'Range loop + Append (C, Get_Net ((Val.Typ.Rec.E (I).Typ, + Val.Val.Rec.V (I)))); end loop; Build (Build_Context, C, Res); return Res; @@ -602,29 +574,24 @@ package body Synth.Context is declare Res : Net; begin - if Val.A_Obj.Kind = Value_Wire then - Res := Get_Current_Value (Build_Context, Val.A_Obj.W); - return Build_Extract (Build_Context, Res, Val.A_Off, - Get_Type_Width (Val.Typ)); + if Val.Val.A_Obj.Kind = Value_Wire then + Res := Get_Current_Value (Build_Context, Val.Val.A_Obj.W); + return Build2_Extract (Build_Context, Res, Val.Val.A_Off, + Val.Typ.W); else - pragma Assert (Val.A_Off = 0); - return Get_Net (Val.A_Obj); + pragma Assert (Val.Val.A_Off = 0); + return Get_Net ((Val.Typ, Val.Val.A_Obj)); end if; end; when Value_Const => - if Val.C_Net = No_Net then - Val.C_Net := Get_Net (Val.C_Val); - Locations.Set_Location (Get_Net_Parent (Val.C_Net), - Get_Location (Val.C_Loc)); + if Val.Val.C_Net = No_Net then + Val.Val.C_Net := Get_Net ((Val.Typ, Val.Val.C_Val)); + Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net), + Get_Location (Val.Val.C_Loc)); end if; - return Val.C_Net; + return Val.Val.C_Net; when others => raise Internal_Error; end case; end Get_Net; - - function Get_Net (Val : Valtyp) return Net is - begin - return Get_Net (Val.Val); - end Get_Net; end Synth.Context; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 9e66b1281..84316b5ef 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -123,7 +123,6 @@ package Synth.Context is -- Get a net from a scalar/vector value. This will automatically create -- a net for literals. - function Get_Net (Val : Value_Acc) return Net; function Get_Net (Val : Valtyp) return Net; function Get_Package_Object diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 4d1914cc0..2c32a7381 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -752,7 +752,8 @@ package body Synth.Decls is Rdwd : Width; Res : Valtyp; Obj_Typ : Type_Acc; - Vt : Valtyp; + Base : Valtyp; + Typ : Type_Acc; begin -- Subtype indication may not be present. if Atype /= Null_Node then @@ -763,16 +764,16 @@ package body Synth.Decls is end if; Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), - Vt, Off, Voff, Rdwd); + Base, Typ, Off, Voff, Rdwd); pragma Assert (Voff = No_Net); - if Vt.Val.Kind = Value_Net then + if Base.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the -- bits for the alias. Res := Create_Value_Net - (Build2_Extract (Get_Build (Syn_Inst), Vt.Val.N, Off, Vt.Typ.W), - Vt.Typ); + (Build2_Extract (Get_Build (Syn_Inst), Base.Val.N, Off, Typ.W), + Typ); else - Res := Create_Value_Alias (Vt.Val, Off, Vt.Typ); + Res := Create_Value_Alias (Base.Val, Off, Typ); end if; if Obj_Typ /= null then Res := Synth_Subtype_Conversion (Res, Obj_Typ, True, Decl); @@ -846,14 +847,14 @@ package body Synth.Decls is when Iir_Kind_File_Declaration => declare F : File_Index; - Res : Value_Acc; + Res : Valtyp; Obj_Typ : Type_Acc; begin F := Synth.Files_Operations.Elaborate_File_Declaration (Syn_Inst, Decl); Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); Res := Create_Value_File (Obj_Typ, F); - Create_Object (Syn_Inst, Decl, (Obj_Typ, Res)); + Create_Object (Syn_Inst, Decl, Res); end; when Iir_Kind_Psl_Default_Clock => -- Ignored; directly used by PSL directives. diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 7330cc793..cf4ef01ea 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -77,19 +77,19 @@ package body Synth.Expr is return Get_Static_Discrete (V.Val); end Get_Static_Discrete; - function Is_Positive (V : Value_Acc) return Boolean + function Is_Positive (V : Valtyp) return Boolean is N : Net; Inst : Instance; begin pragma Assert (V.Typ.Kind = Type_Discrete); - case V.Kind is + case V.Val.Kind is when Value_Discrete => - return V.Scal >= 0; + return V.Val.Scal >= 0; when Value_Const => - return V.C_Val.Scal >= 0; + return V.Val.C_Val.Scal >= 0; when Value_Net => - N := V.N; + N := V.Val.N; when Value_Wire => N := Get_Net (V); when others => @@ -179,13 +179,13 @@ package body Synth.Expr is end loop; end Uns2logvec; - procedure Value2logvec (Val : Value_Acc; + procedure Value2logvec (Val : Valtyp; Vec : in out Logvec_Array; Off : in out Uns32; Has_Zx : in out Boolean) is begin - if Val.Kind = Value_Const then - Value2logvec (Val.C_Val, Vec, Off, Has_Zx); + if Val.Val.Kind = Value_Const then + Value2logvec ((Val.Typ, Val.Val.C_Val), Vec, Off, Has_Zx); return; end if; @@ -196,7 +196,7 @@ package body Synth.Expr is Pos : constant Natural := Natural (Off mod 32); Va : Uns32; begin - Va := Uns32 (Val.Scal); + Va := Uns32 (Val.Val.Scal); Va := Shift_Left (Va, Pos); Vec (Idx).Val := Vec (Idx).Val or Va; Vec (Idx).Zx := 0; @@ -209,7 +209,7 @@ package body Synth.Expr is Va : Uns32; Zx : Uns32; begin - From_Std_Logic (Val.Scal, Va, Zx); + From_Std_Logic (Val.Val.Scal, Va, Zx); Has_Zx := Has_Zx or Zx /= 0; Va := Shift_Left (Va, Pos); Zx := Shift_Left (Zx, Pos); @@ -218,24 +218,27 @@ package body Synth.Expr is Off := Off + 1; end; when Type_Discrete => - Uns2logvec (To_Uns64 (Val.Scal), Val.Typ.W, Vec, Off); + Uns2logvec (To_Uns64 (Val.Val.Scal), Val.Typ.W, Vec, Off); when Type_Vector => -- TODO: optimize off mod 32 = 0. - for I in reverse Val.Arr.V'Range loop - Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx); + for I in reverse Val.Val.Arr.V'Range loop + Value2logvec ((Val.Typ.Vec_El, Val.Val.Arr.V (I)), + Vec, Off, Has_Zx); end loop; when Type_Array => - for I in reverse Val.Arr.V'Range loop - Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx); + for I in reverse Val.Val.Arr.V'Range loop + Value2logvec ((Val.Typ.Arr_El, Val.Val.Arr.V (I)), + Vec, Off, Has_Zx); end loop; when Type_Record => - for I in Val.Rec.V'Range loop - Value2logvec (Val.Rec.V (I), Vec, Off, Has_Zx); + for I in Val.Val.Rec.V'Range loop + Value2logvec ((Val.Typ.Rec.E (I).Typ, Val.Val.Rec.V (I)), + Vec, Off, Has_Zx); end loop; when Type_Float => -- Fp64 is for sure 64 bits. Assume the endianness of floats is -- the same as integers endianness. - Uns2logvec (To_Uns64 (Val.Fp), 64, Vec, Off); + Uns2logvec (To_Uns64 (Val.Val.Fp), 64, Vec, Off); when others => raise Internal_Error; end case; @@ -435,7 +438,7 @@ package body Synth.Expr is for I in 1 .. Len loop E := Build_Extract (Build_Context, N, Uns32 (Len - I) * El_Typ.W, El_Typ.W); - Res.V (Pos + I - 1) := Create_Value_Net (E, El_Typ); + Res.V (Pos + I - 1) := Create_Value_Net (E, El_Typ).Val; end loop; Const_P := False; end; @@ -1222,7 +1225,7 @@ package body Synth.Expr is P := Dat.V'First; for I in Str'Range loop Dat.V (P) := Create_Value_Discrete (Int64 (Character'Pos (Str (I))), - Etyp); + Etyp).Val; P := P + 1; end loop; return Create_Value_Const_Array (Typ, Dat); @@ -1274,16 +1277,15 @@ package body Synth.Expr is Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Type (Name)); begin - return (Typ, Create_Value_Discrete - (Int64 (Get_Enum_Pos (Name)), Typ)); + return Create_Value_Discrete (Int64 (Get_Enum_Pos (Name)), Typ); end; when Iir_Kind_Unit_Declaration => declare Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Type (Name)); begin - return (Typ, Create_Value_Discrete - (Vhdl.Evaluation.Get_Physical_Value (Name), Typ)); + return Create_Value_Discrete + (Vhdl.Evaluation.Get_Physical_Value (Name), Typ); end; when Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => @@ -1801,7 +1803,7 @@ package body Synth.Expr is Lit : Node; Posedge : Boolean; begin - Clk := Get_Net (Synth_Name (Syn_Inst, Prefix).Val); + Clk := Get_Net (Synth_Name (Syn_Inst, Prefix)); if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); return Build_Edge (Build_Context, Clk); @@ -1972,7 +1974,7 @@ package body Synth.Expr is for I in Arr.V'Range loop -- FIXME: use literal from type ?? Pos := Str_Table.Element_String8 (Id, Pos32 (I)); - Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type); + Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type).Val; end loop; Res := Create_Value_Const_Array (Res_Type, Arr); @@ -2043,8 +2045,7 @@ package body Synth.Expr is return Create_Value_Discrete (Val, Boolean_Type); end if; - N := Build_Dyadic (Build_Context, Id, - Get_Net (Left.Val), Get_Net (Right.Val)); + N := Build_Dyadic (Build_Context, Id, Get_Net (Left), Get_Net (Right)); Set_Location (N, Expr); return Create_Value_Net (N, Boolean_Type); end Synth_Short_Circuit; @@ -2132,19 +2133,20 @@ package body Synth.Expr is when Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name => declare - Vt : Valtyp; + Base : Valtyp; + Typ : Type_Acc; Off : Uns32; Voff : Net; Rdwd : Width; begin - Synth_Assignment_Prefix (Syn_Inst, Expr, Vt, Off, Voff, Rdwd); - if Voff = No_Net and then Is_Static (Vt.Val) then + Synth_Assignment_Prefix + (Syn_Inst, Expr, Base, Typ, Off, Voff, Rdwd); + if Voff = No_Net and then Is_Static (Base.Val) then pragma Assert (Off = 0); - return Vt; + return Base; end if; - return Synth_Read_Memory - (Syn_Inst, Vt.Val, Off, Voff, Vt.Typ, Expr); + return Synth_Read_Memory (Syn_Inst, Base, Typ, Off, Voff, Expr); end; when Iir_Kind_Selected_Element => declare @@ -2161,7 +2163,7 @@ package body Synth.Expr is return (Res_Typ, Res.Val.Rec.V (Idx + 1)); else N := Build_Extract - (Build_Context, Get_Net (Res.Val), + (Build_Context, Get_Net (Res), Res.Typ.Rec.E (Idx + 1).Off, Get_Type_Width (Res_Typ)); Set_Location (N, Expr); return Create_Value_Net (N, Res_Typ); diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index ff713ff6a..84544eadf 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -44,7 +44,7 @@ package Synth.Expr is -- Return True only if discrete value V is known to be positive or 0. -- False means either not positive or unknown. - function Is_Positive (V : Value_Acc) return Boolean; + function Is_Positive (V : Valtyp) return Boolean; -- Return the bounds of a one dimensional array/vector type and the -- width of the element. @@ -130,7 +130,7 @@ package Synth.Expr is procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation (Logvec_Array, Logvec_Array_Acc); - procedure Value2logvec (Val : Value_Acc; + procedure Value2logvec (Val : Valtyp; Vec : in out Logvec_Array; Off : in out Uns32; Has_Zx : in out Boolean); diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index f5f996a6e..d840035be 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -44,7 +44,7 @@ package body Synth.Files_Operations is end File_Error; -- VAL represents a string, so an array of characters. - procedure Convert_String (Val : Value_Acc; Res : out String) + procedure Convert_String (Val : Valtyp; Res : out String) is Vtyp : constant Type_Acc := Val.Typ; begin @@ -54,9 +54,9 @@ package body Synth.Files_Operations is pragma Assert (Vtyp.Abounds.Len = 1); pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); - for I in Val.Arr.V'Range loop + for I in Val.Val.Arr.V'Range loop Res (Res'First + Natural (I - 1)) := - Character'Val (Val.Arr.V (I).Scal); + Character'Val (Val.Val.Arr.V (I).Scal); end loop; end Convert_String; @@ -66,10 +66,10 @@ package body Synth.Files_Operations is Len : out Natural; Status : out Op_Status) is - Name : constant Value_Acc := Strip_Alias_Const (Val.Val); + Name : constant Valtyp := Strip_Alias_Const (Val); pragma Unreferenced (Val); begin - Len := Natural (Name.Arr.Len); + Len := Natural (Name.Val.Arr.Len); if Len >= Res'Length - 1 then Status := Op_Filename_Error; diff --git a/src/synth/synth-heap.adb b/src/synth/synth-heap.adb index 8db5b77de..76935a93c 100644 --- a/src/synth/synth-heap.adb +++ b/src/synth/synth-heap.adb @@ -37,10 +37,10 @@ package body Synth.Heap is when Type_Bit | Type_Logic => return new Value_Type' - (Kind => Value_Discrete, Typ => T, Scal => 0); + (Kind => Value_Discrete, Scal => 0); when Type_Discrete => return new Value_Type' - (Kind => Value_Discrete, Typ => T, Scal => T.Drange.Left); + (Kind => Value_Discrete, Scal => T.Drange.Left); when Type_Array => declare Len : constant Uns32 := Get_Array_Flat_Length (T); @@ -52,7 +52,7 @@ package body Synth.Heap is Arr.V (I) := Allocate_By_Type (El_Typ); end loop; return new Value_Type' - (Kind => Value_Const_Array, Typ => T, Arr => Arr); + (Kind => Value_Const_Array, Arr => Arr); end; when others => raise Internal_Error; @@ -73,8 +73,7 @@ package body Synth.Heap is | Value_Wire => raise Internal_Error; when Value_Discrete => - return new Value_Type' - (Kind => Value_Discrete, Typ => V.Typ, Scal => V.Val.Scal); + return new Value_Type'(Kind => Value_Discrete, Scal => V.Val.Scal); when Value_Array | Value_Const_Array => declare @@ -86,8 +85,7 @@ package body Synth.Heap is Arr.V (I) := Allocate_By_Value ((El_Typ, V.Val.Arr.V (I))); end loop; - return new Value_Type' - (Kind => Value_Const_Array, Typ => V.Typ, Arr => Arr); + return new Value_Type'(Kind => Value_Const_Array, Arr => Arr); end; when others => raise Internal_Error; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 824fa63bb..93d601a5f 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -368,7 +368,7 @@ package body Synth.Insts is Nbr_Outputs : Port_Nbr; Nbr_Params : Param_Nbr; Cur_Module : Module; - Val : Value_Acc; + Val : Valtyp; Id : Module_Id; begin if Get_Kind (Params.Decl) = Iir_Kind_Component_Declaration then @@ -430,7 +430,7 @@ package body Synth.Insts is Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Nbr_Outputs := Nbr_Outputs + 1; end case; - Create_Object (Syn_Inst, Inter, (Inter_Typ, Val)); + Create_Object (Syn_Inst, Inter, Val); Inter := Get_Chain (Inter); end loop; @@ -850,7 +850,7 @@ package body Synth.Insts is Vec := new Logvec_Array'(0 .. Digit_Index (Len - 1) => (0, 0)); Off := 0; Has_Zx := False; - Value2logvec (Vt.Val, Vec.all, Off, Has_Zx); + Value2logvec (Vt, Vec.all, Off, Has_Zx); if Has_Zx then Pv := Create_Pval4 (Vt.Typ.W); else @@ -901,7 +901,7 @@ package body Synth.Insts is Inter : Node; Assoc : Node; Assoc_Inter : Node; - Val : Value_Acc; + Val : Valtyp; Inter_Typ : Type_Acc; begin Assoc := Assoc_Chain; @@ -918,7 +918,7 @@ package body Synth.Insts is | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; - Create_Object (Sub_Inst, Inter, (Inter_Typ, Val)); + Create_Object (Sub_Inst, Inter, Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; @@ -1023,19 +1023,19 @@ package body Synth.Insts is end Synth_Blackbox_Instantiation_Statement; procedure Create_Component_Wire - (Ctxt : Context_Acc; Inter : Node; Val : Value_Acc; Pfx_Name : Sname) + (Ctxt : Context_Acc; Inter : Node; Val : Valtyp; Pfx_Name : Sname) is Value : Net; W : Width; begin - case Val.Kind is + case Val.Val.Kind is when Value_Wire => -- Create a gate for the output, so that it could be read. - Val.W := Alloc_Wire (Wire_Output, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, Inter); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); - Set_Wire_Gate (Val.W, Value); + Set_Wire_Gate (Val.Val.W, Value); when others => raise Internal_Error; end case; @@ -1082,7 +1082,7 @@ package body Synth.Insts is Assoc_Inter : Node; Inter : Node; Inter_Typ : Type_Acc; - Val : Value_Acc; + Val : Valtyp; N : Net; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); @@ -1105,7 +1105,7 @@ package body Synth.Insts is Create_Component_Wire (Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name); end case; - Create_Object (Comp_Inst, Assoc_Inter, (Val.Typ, Val)); + Create_Object (Comp_Inst, Assoc_Inter, Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; @@ -1181,7 +1181,7 @@ package body Synth.Insts is if Mode_To_Port_Kind (Get_Mode (Inter)) = Port_Out then O := Get_Value (Comp_Inst, Inter); - Port := Get_Net (O.Val); + Port := Get_Net (O); Synth_Output_Assoc (Port, Syn_Inst, Assoc, Comp_Inst, Inter); Nbr_Outputs := Nbr_Outputs + 1; end if; @@ -1256,7 +1256,7 @@ package body Synth.Insts is Inter : Node; Inter_Typ : Type_Acc; Inst_Obj : Inst_Object; - Val : Value_Acc; + Val : Valtyp; begin Root_Instance := Global_Instance; @@ -1309,7 +1309,7 @@ package body Synth.Insts is | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; - Create_Object (Syn_Inst, Inter, (Inter_Typ, Val)); + Create_Object (Syn_Inst, Inter, Val); Inter := Get_Chain (Inter); end loop; @@ -1353,7 +1353,7 @@ package body Synth.Insts is -- Create a gate for the output, so that it could be read. Val.W := Alloc_Wire (Wire_Output, Inter); - pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); + -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); Inp := Get_Input (Self_Inst, Idx); diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index 9be4b6dc6..e9f93fb0e 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -583,7 +583,7 @@ package body Synth.Oper is N : Net; Is_Pos : Boolean; begin - Is_Pos := Is_Positive (Right.Val); + Is_Pos := Is_Positive (Right); L1 := Get_Net (Left); R1 := Get_Net (Right); @@ -611,7 +611,7 @@ package body Synth.Oper is Amt := Amt mod Int64 (Left.Typ.W); R1 := Build_Const_UB32 (Ctxt, Uns32 (Amt), Right.Typ.W); Set_Location (R1, Right_Expr); - elsif not Is_Positive (Right.Val) then + elsif not Is_Positive (Right) then Error_Msg_Synth (+Expr, "rotation quantity must be unsigned"); return Left; else @@ -1436,7 +1436,7 @@ package body Synth.Oper is return No_Valtyp; end if; Size := Uns32 (Strip_Const (Size_Vt.Val).Scal); - Arg_Net := Get_Net (Arg.Val); + Arg_Net := Get_Net (Arg); Arg_Net := Build2_Resize (Ctxt, Arg_Net, Size, Is_Signed, Get_Location (Expr)); return Create_Value_Net diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index be54806b8..641289492 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -301,7 +301,6 @@ package body Synth.Static_Oper is Op : Table_2d; Loc : Syn_Src) return Valtyp is - El_Typ : constant Type_Acc := Left.Typ.Vec_El; Larr : constant Static_Arr_Type := Get_Static_Array (Left); Rarr : constant Static_Arr_Type := Get_Static_Array (Right); Arr : Value_Array_Acc; @@ -320,7 +319,7 @@ package body Synth.Static_Oper is Get_Static_Std_Logic (Rarr, Uns32 (I - 1)); V : constant Std_Ulogic := Op (Ls, Rs); begin - Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (V), El_Typ); + Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (V)); end; end loop; @@ -355,7 +354,7 @@ package body Synth.Static_Oper is Arr := Create_Value_Array (Iir_Index32 (Vec'Last)); for I in Vec'Range loop Arr.V (Iir_Index32 (I)) := - Create_Value_Discrete (Std_Ulogic'Pos (Vec (I)), El_Typ); + Create_Value_Discrete (Std_Ulogic'Pos (Vec (I))); end loop; return Create_Value_Const_Array (Res_Typ, Arr); end To_Valtyp; @@ -910,7 +909,6 @@ package body Synth.Static_Oper is function Synth_Vector_Monadic (Vec : Valtyp; Op : Table_1d) return Valtyp is - El_Typ : constant Type_Acc := Vec.Typ.Vec_El; Arr : Value_Array_Acc; begin Arr := Create_Value_Array (Vec.Val.Arr.Len); @@ -918,8 +916,7 @@ package body Synth.Static_Oper is declare V : constant Std_Ulogic := Std_Ulogic'Val (Vec.Val.Arr.V (I).Scal); begin - Arr.V (I) := - Create_Value_Discrete (Std_Ulogic'Pos (Op (V)), El_Typ); + Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (Op (V))); end; end loop; @@ -1039,19 +1036,19 @@ package body Synth.Static_Oper is for I in 1 .. Len loop B := Shift_Right_Arithmetic (Arg, Natural (I - 1)) and 1; Arr.V (Len - I + 1) := Create_Value_Discrete - (Std_Logic_0_Pos + Int64 (B), El_Type); + (Std_Logic_0_Pos + Int64 (B)); end loop; Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type); return Create_Value_Const_Array (Bnd, Arr); end Eval_To_Vector; - function Eval_Unsigned_To_Integer (Arg : Value_Acc; Loc : Node) return Int64 + function Eval_Unsigned_To_Integer (Arg : Valtyp; Loc : Node) return Int64 is Res : Uns64; begin Res := 0; - for I in Arg.Arr.V'Range loop - case To_X01 (Std_Ulogic'Val (Arg.Arr.V (I).Scal)) is + for I in Arg.Val.Arr.V'Range loop + case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (I).Scal)) is when '0' => Res := Res * 2; when '1' => @@ -1066,17 +1063,17 @@ package body Synth.Static_Oper is return To_Int64 (Res); end Eval_Unsigned_To_Integer; - function Eval_Signed_To_Integer (Arg : Value_Acc; Loc : Node) return Int64 + function Eval_Signed_To_Integer (Arg : Valtyp; Loc : Node) return Int64 is Res : Uns64; begin - if Arg.Arr.Len = 0 then + if Arg.Val.Arr.Len = 0 then Warning_Msg_Synth (+Loc, "numeric_std.to_integer: null detected, returning 0"); return 0; end if; - case To_X01 (Std_Ulogic'Val (Arg.Arr.V (1).Scal)) is + case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (1).Scal)) is when '0' => Res := 0; when '1' => @@ -1085,8 +1082,8 @@ package body Synth.Static_Oper is Warning_Msg_Synth (+Loc, "metavalue detected, returning 0"); return 0; end case; - for I in 2 .. Arg.Arr.Len loop - case To_X01 (Std_Ulogic'Val (Arg.Arr.V (I).Scal)) is + for I in 2 .. Arg.Val.Arr.Len loop + case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (I).Scal)) is when '0' => Res := Res * 2; when '1' => @@ -1106,25 +1103,25 @@ package body Synth.Static_Oper is Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); - Param1 : Value_Acc; - Param2 : Value_Acc; + Param1 : Valtyp; + Param2 : Valtyp; Res_Typ : Type_Acc; Inter : Node; begin Inter := Inter_Chain; if Inter /= Null_Node then - Param1 := Get_Value (Subprg_Inst, Inter).Val; + Param1 := Get_Value (Subprg_Inst, Inter); Strip_Const (Param1); Inter := Get_Chain (Inter); else - Param1 := null; + Param1 := No_Valtyp; end if; if Inter /= Null_Node then - Param2 := Get_Value (Subprg_Inst, Inter).Val; + Param2 := Get_Value (Subprg_Inst, Inter); Strip_Const (Param2); Inter := Get_Chain (Inter); else - Param2 := null; + Param2 := No_Valtyp; end if; Res_Typ := Get_Subtype_Object (Subprg_Inst, Get_Type (Imp)); @@ -1134,18 +1131,18 @@ package body Synth.Static_Oper is declare Res : Boolean; begin - Res := Synth.Files_Operations.Endfile (Param1.File, Expr); + Res := Synth.Files_Operations.Endfile (Param1.Val.File, Expr); return Create_Value_Discrete (Boolean'Pos (Res), Boolean_Type); end; when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Int => return Eval_To_Vector - (Uns64 (Param1.Scal), Param2.Scal, Res_Typ); + (Uns64 (Param1.Val.Scal), Param2.Val.Scal, Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Nat_Sgn | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int => return Eval_To_Vector - (To_Uns64 (Param1.Scal), Param2.Scal, Res_Typ); + (To_Uns64 (Param1.Val.Scal), Param2.Val.Scal, Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Uns | Iir_Predefined_Ieee_Std_Logic_Unsigned_Conv_Integer => @@ -1164,17 +1161,17 @@ package body Synth.Static_Oper is Bnd : Type_Acc; B : Int64; begin - Arr := Create_Value_Array (Param1.Arr.Len); - for I in Param1.Arr.V'Range loop - if Param1.Arr.V (I).Scal = 0 then + Arr := Create_Value_Array (Param1.Val.Arr.Len); + for I in Param1.Val.Arr.V'Range loop + if Param1.Val.Arr.V (I).Scal = 0 then B := Std_Logic_0_Pos; else B := Std_Logic_1_Pos; end if; - Arr.V (I) := Create_Value_Discrete (B, El_Type); + Arr.V (I) := Create_Value_Discrete (B); end loop; Bnd := Create_Vec_Type_By_Length - (Width (Param1.Arr.Len), El_Type); + (Width (Param1.Val.Arr.Len), El_Type); return Create_Value_Const_Array (Bnd, Arr); end; when Iir_Predefined_Ieee_Math_Real_Log2 => @@ -1182,35 +1179,35 @@ package body Synth.Static_Oper is function Log2 (Arg : Fp64) return Fp64; pragma Import (C, Log2); begin - return Create_Value_Float (Log2 (Param1.Fp), Res_Typ); + return Create_Value_Float (Log2 (Param1.Val.Fp), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Ceil => declare function Ceil (Arg : Fp64) return Fp64; pragma Import (C, Ceil); begin - return Create_Value_Float (Ceil (Param1.Fp), Res_Typ); + return Create_Value_Float (Ceil (Param1.Val.Fp), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Round => declare function Round (Arg : Fp64) return Fp64; pragma Import (C, Round); begin - return Create_Value_Float (Round (Param1.Fp), Res_Typ); + return Create_Value_Float (Round (Param1.Val.Fp), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Sin => declare function Sin (Arg : Fp64) return Fp64; pragma Import (C, Sin); begin - return Create_Value_Float (Sin (Param1.Fp), Res_Typ); + return Create_Value_Float (Sin (Param1.Val.Fp), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Cos => declare function Cos (Arg : Fp64) return Fp64; pragma Import (C, Cos); begin - return Create_Value_Float (Cos (Param1.Fp), Res_Typ); + return Create_Value_Float (Cos (Param1.Val.Fp), Res_Typ); end; when others => Error_Msg_Synth diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 80d650b66..e2da5d317 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -93,19 +93,24 @@ package body Synth.Stmts is Typ : Type_Acc; Val : Valtyp; Offset : Uns32; - Loc : Source.Syn_Src) is + Loc : Source.Syn_Src) + is + Cval : Valtyp; + N : Net; begin if Val = No_Valtyp then + -- In case of error. return; end if; - Phi_Assign (Build_Context, Wid, - Get_Net (Synth_Subtype_Conversion (Val, Typ, False, Loc)), - Offset); + Cval := Synth_Subtype_Conversion (Val, Typ, False, Loc); + N := Get_Net (Cval); + Phi_Assign (Build_Context, Wid, N, Offset); end Synth_Assign; procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; - Dest_Valtyp : out Valtyp; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; Dest_Off : out Uns32; Dest_Voff : out Net; Dest_Rdwd : out Width) is @@ -113,7 +118,7 @@ package body Synth.Stmts is case Get_Kind (Pfx) is when Iir_Kind_Simple_Name => Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), - Dest_Valtyp, Dest_Off, + Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration @@ -130,18 +135,20 @@ package body Synth.Stmts is begin Dest_Voff := No_Net; Dest_Rdwd := 0; + Dest_Typ := Targ.Typ; if Targ.Val.Kind = Value_Alias then -- Replace alias by the aliased name. - Dest_Valtyp := (Targ.Typ, Targ.Val.A_Obj); + Dest_Base := (Targ.Typ, Targ.Val.A_Obj); Dest_Off := Targ.Val.A_Off; else - Dest_Valtyp := Targ; + Dest_Base := Targ; Dest_Off := 0; end if; end; when Iir_Kind_Function_Call => - Dest_Valtyp := Synth_Expression (Syn_Inst, Pfx); + Dest_Base := Synth_Expression (Syn_Inst, Pfx); + Dest_Typ := Dest_Base.Typ; Dest_Off := 0; Dest_Voff := No_Net; Dest_Rdwd := 0; @@ -154,13 +161,12 @@ package body Synth.Stmts is begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); - Strip_Const (Dest_Valtyp); - Dest_W := Dest_Valtyp.Typ.W; - Synth_Indexed_Name - (Syn_Inst, Pfx, Dest_Valtyp.Typ, Voff, Off, W); + Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); + Strip_Const (Dest_Base); + Dest_W := Dest_Base.Typ.W; + Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off, W); - Dest_Valtyp.Typ := Get_Array_Element (Dest_Valtyp.Typ); + Dest_Typ := Get_Array_Element (Dest_Typ); if Voff /= No_Net then Dest_Off := Dest_Off + Off; @@ -177,11 +183,13 @@ package body Synth.Stmts is if Dest_Voff = No_Net then -- For constant objects, directly return the indexed -- object. - if Dest_Valtyp.Val.Kind + if Dest_Base.Val.Kind in Value_Array .. Value_Const_Array then - Dest_Valtyp.Val := Dest_Valtyp.Val.Arr.V + pragma Assert (Dest_Off = Off); + Dest_Base.Val := Dest_Base.Val.Arr.V (Iir_Index32 ((Dest_W - Dest_Off) / W)); + Dest_Base.Typ := Dest_Typ; Dest_Off := 0; Dest_W := W; end if; @@ -193,23 +201,26 @@ package body Synth.Stmts is declare Idx : constant Iir_Index32 := Get_Element_Position (Get_Named_Entity (Pfx)); + El_Typ : Type_Acc; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); + Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); if Dest_Off /= 0 and then Dest_Voff /= No_Net then -- TODO. raise Internal_Error; end if; - Strip_Const (Dest_Valtyp); - if Dest_Valtyp.Val.Kind = Value_Const_Record then + El_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; + Strip_Const (Dest_Base); + if Dest_Base.Val.Kind = Value_Const_Record then -- Return the selected element. pragma Assert (Dest_Off = 0); - Dest_Valtyp.Val := Dest_Valtyp.Val.Rec.V (Idx + 1); + Dest_Base.Val := Dest_Base.Val.Rec.V (Idx + 1); + Dest_Base.Typ := El_Typ; else - Dest_Off := Dest_Off + Dest_Valtyp.Typ.Rec.E (Idx + 1).Off; + Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Off; end if; - Dest_Valtyp.Typ := Dest_Valtyp.Typ.Rec.E (Idx + 1).Typ; + Dest_Typ := El_Typ; end; when Iir_Kind_Slice_Name => @@ -223,11 +234,10 @@ package body Synth.Stmts is begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); - Strip_Const (Dest_Valtyp); + Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); + Strip_Const (Dest_Base); - Get_Onedimensional_Array_Bounds - (Dest_Valtyp.Typ, Pfx_Bnd, El_Typ); + Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ.W, Res_Bnd, Sl_Voff, Sl_Off, Wd); @@ -238,20 +248,19 @@ package body Synth.Stmts is Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Sl_Voff); else - Dest_Rdwd := Dest_Valtyp.Typ.W; + Dest_Rdwd := Dest_Base.Typ.W; Dest_Voff := Sl_Voff; end if; - Dest_Valtyp.Typ := Create_Slice_Type (Wd, El_Typ); + Dest_Typ := Create_Slice_Type (Wd, El_Typ); else -- Fixed slice. - Dest_Valtyp.Typ := Create_Onedimensional_Array_Subtype - (Dest_Valtyp.Typ, Res_Bnd); + Dest_Typ := Create_Onedimensional_Array_Subtype + (Dest_Typ, Res_Bnd); if Dest_Voff /= No_Net then -- Slice of a memory. Dest_Off := Dest_Off + Sl_Off; else - if Dest_Valtyp.Val.Kind - in Value_Array .. Value_Const_Array + if Dest_Base.Val.Kind in Value_Array .. Value_Const_Array then declare Arr : Value_Array_Acc; @@ -268,15 +277,14 @@ package body Synth.Stmts is Off := Iir_Index32 (Pfx_Bnd.Left - Res_Bnd.Left); end case; - Arr.V := Dest_Valtyp.Val.Arr.V + Arr.V := Dest_Base.Val.Arr.V (Off + 1 .. Off + Iir_Index32 (Res_Bnd.Len)); - if Dest_Valtyp.Val.Kind = Value_Array then - Dest_Valtyp.Val := Create_Value_Array - (Dest_Valtyp.Typ, Arr); + if Dest_Base.Val.Kind = Value_Array then + Dest_Base.Val := Create_Value_Array (Arr); else - Dest_Valtyp.Val := Create_Value_Const_Array - (Dest_Valtyp.Typ, Arr); + Dest_Base.Val := Create_Value_Const_Array (Arr); end if; + Dest_Base.Typ := Dest_Typ; end; else -- Slice of a vector. @@ -290,11 +298,12 @@ package body Synth.Stmts is | Iir_Kind_Dereference => Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); + Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); if Dest_Off /= 0 and then Dest_Voff /= No_Net then raise Internal_Error; end if; - Dest_Valtyp := Heap.Synth_Dereference (Dest_Valtyp.Val.Acc); + Dest_Base := Heap.Synth_Dereference (Dest_Base.Val.Acc); + Dest_Typ := Dest_Base.Typ; when others => Error_Kind ("synth_assignment_prefix", Pfx); @@ -319,7 +328,7 @@ package body Synth.Stmts is Aggr : Node; when Target_Memory => -- For a memory: the destination is known. - Mem_Obj : Value_Acc; + Mem_Obj : Valtyp; -- The dynamic offset. Mem_Voff : Net; -- Offset of the memory in the wire (usually 0). @@ -366,23 +375,25 @@ package body Synth.Stmts is | Iir_Kind_Slice_Name | Iir_Kind_Dereference => declare - Vt : Valtyp; + Base : Valtyp; + Typ : Type_Acc; Off : Uns32; Voff : Net; Rdwd : Width; begin - Synth_Assignment_Prefix (Syn_Inst, Target, Vt, Off, Voff, Rdwd); + Synth_Assignment_Prefix + (Syn_Inst, Target, Base, Typ, Off, Voff, Rdwd); if Voff = No_Net then -- FIXME: check index. return Target_Info'(Kind => Target_Simple, - Targ_Type => Vt.Typ, - Obj => Vt.Val, + Targ_Type => Typ, + Obj => Base.Val, Off => Off); else return Target_Info'(Kind => Target_Memory, - Targ_Type => Vt.Typ, - Mem_Obj => Vt.Val, + Targ_Type => Typ, + Mem_Obj => Base, Mem_Mwidth => Rdwd, Mem_Moff => 0, Mem_Voff => Voff, @@ -522,13 +533,13 @@ package body Synth.Stmts is V : Net; begin V := Get_Current_Assign_Value - (Get_Build (Syn_Inst), Target.Mem_Obj.W, Target.Mem_Moff, - Target.Mem_Mwidth); + (Get_Build (Syn_Inst), Target.Mem_Obj.Val.W, + Target.Mem_Moff, Target.Mem_Mwidth); V := Build_Dyn_Insert (Get_Build (Syn_Inst), V, Get_Net (Val), Target.Mem_Voff, Target.Mem_Doff); Set_Location (V, Loc); Synth_Assign - (Target.Mem_Obj.W, Target.Targ_Type, + (Target.Mem_Obj.Val.W, Target.Targ_Type, Create_Value_Net (V, Target.Targ_Type), Target.Mem_Moff, Loc); end; @@ -547,31 +558,26 @@ package body Synth.Stmts is end Synth_Assignment; function Synth_Read_Memory (Syn_Inst : Synth_Instance_Acc; - Obj : Value_Acc; + Obj : Valtyp; + Res_Typ : Type_Acc; Off : Uns32; Voff : Net; - Typ : Type_Acc; Loc : Node) return Valtyp is N : Net; begin + N := Get_Net (Obj); if Voff /= No_Net then - N := Get_Net (Obj); Synth.Source.Set_Location_Maybe (N, Loc); - N := Build_Dyn_Extract (Get_Build (Syn_Inst), N, Voff, Off, Typ.W); + N := Build_Dyn_Extract + (Get_Build (Syn_Inst), N, Voff, Off, Res_Typ.W); else - pragma Assert (not Is_Static (Obj)); - if Off = 0 - and then Typ.W = Obj.Typ.W - and then Typ /= Get_Array_Element (Obj.Typ) - then - -- Nothing to do if extracting the whole object as a slice. - return (Typ, Obj); - end if; - N := Build_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Off, Typ.W); + pragma Assert (not Is_Static (Obj.Val)); + N := Build2_Extract + (Get_Build (Syn_Inst), N, Off, Res_Typ.W); end if; Set_Location (N, Loc); - return Create_Value_Net (N, Typ); + return Create_Value_Net (N, Res_Typ); end Synth_Read_Memory; function Synth_Read (Syn_Inst : Synth_Instance_Acc; @@ -582,15 +588,15 @@ package body Synth.Stmts is begin case Targ.Kind is when Target_Simple => - N := Build2_Extract - (Get_Build (Syn_Inst), - Get_Net (Targ.Obj), Targ.Off, Targ.Targ_Type.W); + N := Build2_Extract (Get_Build (Syn_Inst), + Get_Net ((Targ.Targ_Type, Targ.Obj)), + Targ.Off, Targ.Targ_Type.W); return Create_Value_Net (N, Targ.Targ_Type); when Target_Aggregate => raise Internal_Error; when Target_Memory => - return Synth_Read_Memory (Syn_Inst, Targ.Mem_Obj, Targ.Mem_Moff, - Targ.Mem_Voff, Targ.Targ_Type, Loc); + return Synth_Read_Memory (Syn_Inst, Targ.Mem_Obj, Targ.Targ_Type, + Targ.Mem_Moff, Targ.Mem_Voff, Loc); end case; end Synth_Read; @@ -785,7 +791,7 @@ package body Synth.Stmts is Off := 0; Has_Zx := False; Vec := (others => (0, 0)); - Value2logvec (Expr_Val.Val, Vec, Off, Has_Zx); + Value2logvec (Expr_Val, Vec, Off, Has_Zx); if Has_Zx then Error_Msg_Synth (+Expr, "meta-values never match"); end if; @@ -894,7 +900,7 @@ package body Synth.Stmts is (Partial_Assign_Array, Partial_Assign_Array_Acc); procedure Synth_Case_Statement_Dynamic - (C : in out Seq_Context; Stmt : Node; Sel : Value_Acc) + (C : in out Seq_Context; Stmt : Node; Sel : Valtyp) is use Vhdl.Sem_Expr; @@ -1202,7 +1208,7 @@ package body Synth.Stmts is raise Internal_Error; end case; else - Synth_Case_Statement_Dynamic (C, Stmt, Sel.Val); + Synth_Case_Statement_Dynamic (C, Stmt, Sel); end if; end Synth_Case_Statement; @@ -1654,7 +1660,7 @@ package body Synth.Stmts is is Inter : Node; Assoc : Node; - Val : Value_Acc; + Val : Valtyp; Iterator : Association_Iterator; Wire : Wire_Id; begin @@ -1667,14 +1673,14 @@ package body Synth.Stmts is if Get_Mode (Inter) in Iir_Out_Modes and then Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration then - Val := Get_Value (Subprg_Inst, Inter).Val; + Val := Get_Value (Subprg_Inst, Inter); -- Arguments are passed by copy. Wire := Alloc_Wire (Wire_Variable, Inter); Set_Wire_Gate (Wire, Get_Net (Val)); Val := Create_Value_Wire (Wire, Val.Typ); Create_Object_Force (Subprg_Inst, Inter, No_Valtyp); - Create_Object_Force (Subprg_Inst, Inter, (Val.Typ, Val)); + Create_Object_Force (Subprg_Inst, Inter, Val); end if; end loop; end Synth_Subprogram_Association_Wires; @@ -2242,11 +2248,11 @@ package body Synth.Stmts is procedure Init_For_Loop_Statement (C : in out Seq_Context; Stmt : Node; - It_Rng : out Type_Acc; - Val : out Value_Acc) + Val : out Valtyp) is Iterator : constant Node := Get_Parameter_Specification (Stmt); It_Type : constant Node := Get_Declaration_Type (Iterator); + It_Rng : Type_Acc; begin if It_Type /= Null_Node then Synth_Subtype_Indication (C.Inst, It_Type); @@ -2255,7 +2261,7 @@ package body Synth.Stmts is -- Initial value. It_Rng := Get_Subtype_Object (C.Inst, Get_Type (Iterator)); Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); - Create_Object (C.Inst, Iterator, (It_Rng, Val)); + Create_Object (C.Inst, Iterator, Val); end Init_For_Loop_Statement; procedure Finish_For_Loop_Statement (C : in out Seq_Context; @@ -2274,8 +2280,7 @@ package body Synth.Stmts is (C : in out Seq_Context; Stmt : Node) is Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); - It_Rng : Type_Acc; - Val : Value_Acc; + Val : Valtyp; Lc : aliased Loop_Context (Mode_Dynamic); begin Lc := (Mode => Mode_Dynamic, @@ -2290,12 +2295,12 @@ package body Synth.Stmts is Loop_Control_Init (C, Stmt); - Init_For_Loop_Statement (C, Stmt, It_Rng, Val); + Init_For_Loop_Statement (C, Stmt, Val); - while In_Range (It_Rng.Drange, Val.Scal) loop + while In_Range (Val.Typ.Drange, Val.Val.Scal) loop Synth_Sequential_Statements (C, Stmts); - Update_Index (It_Rng.Drange, Val.Scal); + Update_Index (Val.Typ.Drange, Val.Val.Scal); Loop_Control_Update (C); -- Constant exit. @@ -2314,8 +2319,7 @@ package body Synth.Stmts is (C : in out Seq_Context; Stmt : Node) is Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); - It_Rng : Type_Acc; - Val : Value_Acc; + Val : Valtyp; Lc : aliased Loop_Context (Mode_Static); begin Lc := (Mode_Static, @@ -2325,13 +2329,13 @@ package body Synth.Stmts is S_Quit => False); C.Cur_Loop := Lc'Unrestricted_Access; - Init_For_Loop_Statement (C, Stmt, It_Rng, Val); + Init_For_Loop_Statement (C, Stmt, Val); - while In_Range (It_Rng.Drange, Val.Scal) loop + while In_Range (Val.Typ.Drange, Val.Val.Scal) loop Synth_Sequential_Statements (C, Stmts); C.S_En := True; - Update_Index (It_Rng.Drange, Val.Scal); + Update_Index (Val.Typ.Drange, Val.Val.Scal); exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0; end loop; @@ -3114,11 +3118,12 @@ package body Synth.Stmts is end if; end Synth_Psl_Assert_Directive; - procedure Synth_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc; - Bod : Node; - Name : Sname; - Iterator : Node := Null_Node; - Iterator_Val : Value_Acc := null) + procedure Synth_Generate_Statement_Body + (Syn_Inst : Synth_Instance_Acc; + Bod : Node; + Name : Sname; + Iterator : Node := Null_Node; + Iterator_Val : Valtyp := No_Valtyp) is use Areapools; Decls_Chain : constant Node := Get_Declaration_Chain (Bod); @@ -3132,7 +3137,7 @@ package body Synth.Stmts is if Iterator /= Null_Node then -- Add the iterator (for for-generate). - Create_Object (Bod_Inst, Iterator, (Iterator_Val.Typ, Iterator_Val)); + Create_Object (Bod_Inst, Iterator, Iterator_Val); end if; Synth_Declarations (Bod_Inst, Decls_Chain); @@ -3187,7 +3192,7 @@ package body Synth.Stmts is It_Type : constant Node := Get_Declaration_Type (Iterator); Config : Node; It_Rng : Type_Acc; - Val : Value_Acc; + Val : Valtyp; Name : Sname; Lname : Sname; begin @@ -3201,7 +3206,7 @@ package body Synth.Stmts is Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); - while In_Range (It_Rng.Drange, Val.Scal) loop + while In_Range (It_Rng.Drange, Val.Val.Scal) loop -- Find and apply the config block. declare Spec : Node; @@ -3224,10 +3229,10 @@ package body Synth.Stmts is end; -- FIXME: get position ? - Lname := New_Sname_Version (Uns32 (Val.Scal), Name); + Lname := New_Sname_Version (Uns32 (Val.Val.Scal), Name); Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val); - Update_Index (It_Rng.Drange, Val.Scal); + Update_Index (It_Rng.Drange, Val.Val.Scal); end loop; end Synth_For_Generate_Statement; @@ -3347,15 +3352,17 @@ package body Synth.Stmts is Voff : Net; Wd : Width; N : Net; - Vt : Valtyp; + Base : Valtyp; + Typ : Type_Acc; begin - Synth_Assignment_Prefix (Syn_Inst, Sig, Vt, Off, Voff, Wd); + Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off, Voff, Wd); pragma Assert (Off = 0); pragma Assert (Voff = No_Net); - pragma Assert (Vt.Val.Kind = Value_Wire); + pragma Assert (Base.Val.Kind = Value_Wire); + pragma Assert (Base.Typ = Typ); - N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Vt.Typ.W); - Add_Conc_Assign (Vt.Val.W, N, 0, Val); + N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W); + Add_Conc_Assign (Base.Val.W, N, 0, Val); end; end Synth_Attribute_Formal; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index b1514766e..6bd796c70 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -33,9 +33,17 @@ package Synth.Stmts is Inter_Chain : Node; Assoc_Chain : Node); + -- Transform PFX into DEST_*. + -- DEST_BASE is the base object. Can be the result, a net or an array + -- larger than the result. + -- DEST_TYP is the type of the result. + -- DEST_OFF/DEST_VOFF is the offset in the base. DEST_OFF is used when + -- the base is a net, while DEST_VOFF is set when the offset is dynamic. + -- DEST_RDWD is the width of what is extracted from the base. procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; - Dest_Valtyp : out Valtyp; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; Dest_Off : out Uns32; Dest_Voff : out Net; Dest_Rdwd : out Width); @@ -46,10 +54,10 @@ package Synth.Stmts is Loc : Node); function Synth_Read_Memory (Syn_Inst : Synth_Instance_Acc; - Obj : Value_Acc; + Obj : Valtyp; + Res_Typ : Type_Acc; Off : Uns32; Voff : Net; - Typ : Type_Acc; Loc : Node) return Valtyp; function Synth_User_Function_Call diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 45986eed1..079d5638d 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -510,104 +510,103 @@ package body Synth.Values is File_Typ => File_Type))); end Create_File_Type; - function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc + function Create_Value_Wire (W : Wire_Id) return Value_Acc is subtype Value_Type_Wire is Value_Type (Values.Value_Wire); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Wire); begin - pragma Assert (Wtype /= null); return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Wire, - W => W, - Typ => Wtype))); + W => W))); end Create_Value_Wire; - function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp is + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp + is + pragma Assert (Wtype /= null); begin - return (Wtype, Create_Value_Wire (W, Wtype)); + return (Wtype, Create_Value_Wire (W)); end Create_Value_Wire; - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc + function Create_Value_Net (N : Net) return Value_Acc is subtype Value_Type_Net is Value_Type (Value_Net); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Net); begin - pragma Assert (Ntype /= null); return To_Value_Acc - (Alloc (Current_Pool, - Value_Type_Net'(Kind => Value_Net, N => N, Typ => Ntype))); + (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => N))); end Create_Value_Net; - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp is + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp + is + pragma Assert (Ntype /= null); begin - return (Ntype, Create_Value_Net (N, Ntype)); + return (Ntype, Create_Value_Net (N)); end Create_Value_Net; - function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) - return Value_Acc + function Create_Value_Discrete (Val : Int64) return Value_Acc is subtype Value_Type_Discrete is Value_Type (Value_Discrete); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Discrete); begin - pragma Assert (Vtype /= null); return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Discrete, Scal => Val, - Typ => Vtype))); + (Kind => Value_Discrete, Scal => Val))); end Create_Value_Discrete; - function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) - return Valtyp is + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp + is + pragma Assert (Vtype /= null); begin - return (Vtype, Create_Value_Discrete (Val, Vtype)); + return (Vtype, Create_Value_Discrete (Val)); end Create_Value_Discrete; - function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc + function Create_Value_Float (Val : Fp64) return Value_Acc is subtype Value_Type_Float is Value_Type (Value_Float); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Float); begin - pragma Assert (Vtype /= null); return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Float, - Typ => Vtype, - Fp => Val))); + (Kind => Value_Float, Fp => Val))); end Create_Value_Float; - function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp is + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp + is + pragma Assert (Vtype /= null); begin - return (Vtype, Create_Value_Float (Val, Vtype)); + return (Vtype, Create_Value_Float (Val)); end Create_Value_Float; - function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) - return Value_Acc + function Create_Value_Access (Acc : Heap_Index) return Value_Acc is subtype Value_Type_Access is Value_Type (Value_Access); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Access); begin - pragma Assert (Vtype /= null); return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Access, - Typ => Vtype, - Acc => Acc))); + (Kind => Value_Access, Acc => Acc))); end Create_Value_Access; function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) - return Valtyp is + return Valtyp + is + pragma Assert (Vtype /= null); begin - return (Vtype, Create_Value_Access (Vtype, Acc)); + return (Vtype, Create_Value_Access (Acc)); end Create_Value_Access; - function Create_Value_File (Vtype : Type_Acc; File : File_Index) - return Value_Acc + function Create_Value_File (File : File_Index) return Value_Acc is subtype Value_Type_File is Value_Type (Value_File); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_File); begin - pragma Assert (Vtype /= null); return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_File, - Typ => Vtype, - File => File))); + (Kind => Value_File, File => File))); + end Create_Value_File; + + function Create_Value_File (Vtype : Type_Acc; File : File_Index) + return Valtyp + is + pragma Assert (Vtype /= null); + begin + return (Vtype, Create_Value_File (File)); end Create_Value_File; function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc @@ -637,29 +636,27 @@ package body Synth.Values is return To_Value_Array_Acc (Res); end Create_Value_Array; - function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Value_Acc + function Create_Value_Array (Arr : Value_Array_Acc) return Value_Acc is subtype Value_Type_Array is Value_Type (Value_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Array); Res : Value_Acc; begin - pragma Assert (Bounds /= null); Res := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Array, - Arr => Arr, Typ => Bounds))); + (Kind => Value_Array, Arr => Arr))); return Res; end Create_Value_Array; function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp is + return Valtyp + is + pragma Assert (Bounds /= null); begin - return (Bounds, Create_Value_Array (Bounds, Arr)); + return (Bounds, Create_Value_Array (Arr)); end Create_Value_Array; - function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Value_Acc + function Create_Value_Const_Array (Arr : Value_Array_Acc) return Value_Acc is subtype Value_Type_Const_Array is Value_Type (Value_Const_Array); function Alloc is @@ -667,17 +664,17 @@ package body Synth.Values is Res : Value_Acc; begin - pragma Assert (Bounds /= null); Res := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Const_Array, - Arr => Arr, Typ => Bounds))); + (Kind => Value_Const_Array, Arr => Arr))); return Res; end Create_Value_Const_Array; function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp is + return Valtyp + is + pragma Assert (Bounds /= null); begin - return (Bounds, Create_Value_Const_Array (Bounds, Arr)); + return (Bounds, Create_Value_Const_Array (Arr)); end Create_Value_Const_Array; function Get_Array_Flat_Length (Typ : Type_Acc) return Width is @@ -700,7 +697,7 @@ package body Synth.Values is end case; end Get_Array_Flat_Length; - procedure Create_Array_Data (Arr : Value_Acc) + procedure Create_Array_Data (Arr : Valtyp) is Len : Width; begin @@ -713,57 +710,55 @@ package body Synth.Values is raise Internal_Error; end case; - Arr.Arr := Create_Value_Array (Iir_Index32 (Len)); + Arr.Val.Arr := Create_Value_Array (Iir_Index32 (Len)); end Create_Array_Data; function Create_Value_Array (Bounds : Type_Acc) return Value_Acc is Res : Value_Acc; begin - Res := Create_Value_Array (Bounds, null); - Create_Array_Data (Res); + Res := Create_Value_Array (Value_Array_Acc'(null)); + Create_Array_Data ((Bounds, Res)); return Res; end Create_Value_Array; - function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Value_Acc + function Create_Value_Record (Els : Value_Array_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); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Record, - Typ => Typ, Rec => Els))); end Create_Value_Record; function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp is + return Valtyp + is + pragma Assert (Typ /= null); begin - return (Typ, Create_Value_Record (Typ, Els)); + return (Typ, Create_Value_Record (Els)); end Create_Value_Record; - function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Value_Acc + function Create_Value_Const_Record (Els : Value_Array_Acc) return Value_Acc is subtype Value_Type_Const_Record is Value_Type (Value_Const_Record); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Record); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Const_Record, - Typ => Typ, - Rec => Els))); + (Kind => Value_Const_Record, Rec => Els))); end Create_Value_Const_Record; function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp is + return Valtyp + is + pragma Assert (Typ /= null); begin - return (Typ, Create_Value_Const_Record (Typ, Els)); + return (Typ, Create_Value_Const_Record (Els)); end Create_Value_Const_Record; - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) - return Value_Acc + function Create_Value_Alias (Obj : Value_Acc; Off : Uns32) return Value_Acc is subtype Value_Type_Alias is Value_Type (Value_Alias); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Alias); @@ -771,14 +766,15 @@ package body Synth.Values is return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Alias, A_Obj => Obj, - A_Off => Off, - Typ => Typ))); + A_Off => Off))); end Create_Value_Alias; function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) - return Valtyp is + return Valtyp + is + pragma Assert (Typ /= null); begin - return (Typ, Create_Value_Alias (Obj, Off, Typ)); + return (Typ, Create_Value_Alias (Obj, Off)); end Create_Value_Alias; function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) @@ -792,8 +788,7 @@ package body Synth.Values is (Kind => Value_Const, C_Val => Val, C_Loc => Loc, - C_Net => No_Net, - Typ => Val.Typ))); + C_Net => No_Net))); end Create_Value_Const; function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) @@ -843,29 +838,29 @@ package body Synth.Values is begin case Src.Kind is when Value_Net => - Res := Create_Value_Net (Src.N, Src.Typ); + Res := Create_Value_Net (Src.N); when Value_Wire => - Res := Create_Value_Wire (Src.W, Src.Typ); + Res := Create_Value_Wire (Src.W); when Value_Discrete => - Res := Create_Value_Discrete (Src.Scal, Src.Typ); + Res := Create_Value_Discrete (Src.Scal); when Value_Float => - Res := Create_Value_Float (Src.Fp, Src.Typ); + Res := Create_Value_Float (Src.Fp); when Value_Array => Arr := Copy_Array (Src.Arr); - Res := Create_Value_Array (Src.Typ, Arr); + Res := Create_Value_Array (Arr); when Value_Const_Array => Arr := Copy_Array (Src.Arr); - Res := Create_Value_Const_Array (Src.Typ, Arr); + Res := Create_Value_Const_Array (Arr); when Value_Record => Arr := Copy_Array (Src.Rec); - Res := Create_Value_Record (Src.Typ, Arr); + Res := Create_Value_Record (Arr); when Value_Const_Record => Arr := Copy_Array (Src.Rec); - Res := Create_Value_Const_Record (Src.Typ, Arr); + Res := Create_Value_Const_Record (Arr); when Value_Access => - Res := Create_Value_Access (Src.Typ, Src.Acc); + Res := Create_Value_Access (Src.Acc); when Value_File => - Res := Create_Value_File (Src.Typ, Src.File); + Res := Create_Value_File (Src.File); when Value_Const => raise Internal_Error; when Value_Alias => @@ -950,11 +945,11 @@ package body Synth.Values is when Type_Bit | Type_Logic => -- FIXME: what about subtype ? - return Create_Value_Discrete (0, Typ); + return Create_Value_Discrete (0); when Type_Discrete => - return Create_Value_Discrete (Typ.Drange.Left, Typ); + return Create_Value_Discrete (Typ.Drange.Left); when Type_Float => - return Create_Value_Float (Typ.Frange.Left, Typ); + return Create_Value_Float (Typ.Frange.Left); when Type_Vector => declare El_Typ : constant Type_Acc := Typ.Vec_El; @@ -964,7 +959,7 @@ package body Synth.Values is for I in Arr.V'Range loop Arr.V (I) := Create_Value_Default (El_Typ); end loop; - return Create_Value_Const_Array (Typ, Arr); + return Create_Value_Const_Array (Arr); end; when Type_Unbounded_Vector => raise Internal_Error; @@ -980,7 +975,7 @@ package body Synth.Values is for I in Arr.V'Range loop Arr.V (I) := Create_Value_Default (El_Typ); end loop; - return Create_Value_Const_Array (Typ, Arr); + return Create_Value_Const_Array (Arr); end; when Type_Unbounded_Array => raise Internal_Error; @@ -992,10 +987,10 @@ package body Synth.Values is for I in Els.V'Range loop Els.V (I) := Create_Value_Default (Typ.Rec.E (I).Typ); end loop; - return Create_Value_Const_Record (Typ, Els); + return Create_Value_Const_Record (Els); end; when Type_Access => - return Create_Value_Access (Typ, Null_Heap_Index); + return Create_Value_Access (Null_Heap_Index); when Type_File => raise Internal_Error; end case; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index d257664df..6e1b29e80 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -197,7 +197,6 @@ package Synth.Values is subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; type Value_Type (Kind : Value_Kind) is record - Typ : Type_Acc; case Kind is when Value_Net => N : Net; @@ -288,38 +287,35 @@ package Synth.Values is function Are_Types_Equal (L, R : Type_Acc) return Boolean; -- Create a Value_Net. - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc; + function Create_Value_Net (N : Net) return Value_Acc; function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; -- Create a Value_Wire. For a bit wire, RNG must be null. - function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc; + function Create_Value_Wire (W : Wire_Id) return Value_Acc; function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; - function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) - return Value_Acc; + function Create_Value_Discrete (Val : Int64) return Value_Acc; function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp; - function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc; + function Create_Value_Float (Val : Fp64) return Value_Acc; function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp; - function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) - return Value_Acc; + function Create_Value_Access (Acc : Heap_Index) return Value_Acc; function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) return Valtyp; + function Create_Value_File (File : File_Index) return Value_Acc; function Create_Value_File (Vtype : Type_Acc; File : File_Index) - return Value_Acc; + return Valtyp; function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc; -- Create a Value_Array. - function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Value_Acc; + function Create_Value_Array (Arr : Value_Array_Acc) return Value_Acc; function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Valtyp; - function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Value_Acc; + function Create_Value_Const_Array (Arr : Value_Array_Acc) return Value_Acc; function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Valtyp; @@ -327,19 +323,16 @@ package Synth.Values is function Create_Value_Array (Bounds : Type_Acc) return Value_Acc; -- Allocate the ARR component of the Value_Type ARR, using BOUNDS. - procedure Create_Array_Data (Arr : Value_Acc); + -- procedure Create_Array_Data (Arr : Value_Acc); - function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Value_Acc; + function Create_Value_Record (Els : Value_Array_Acc) return Value_Acc; function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Valtyp; - function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Value_Acc; + function Create_Value_Const_Record (Els : Value_Array_Acc) return Value_Acc; function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Valtyp; - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) - return Value_Acc; + function Create_Value_Alias (Obj : Value_Acc; Off : Uns32) return Value_Acc; function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) return Valtyp; function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) -- cgit v1.2.3