diff options
| -rw-r--r-- | src/synth/synth-context.adb | 8 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 4 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 1 | ||||
| -rw-r--r-- | src/synth/synth-oper.adb | 3 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 14 | ||||
| -rw-r--r-- | src/synth/synth-values.adb | 25 | ||||
| -rw-r--r-- | src/synth/synth-values.ads | 23 |
7 files changed, 69 insertions, 9 deletions
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 5f7c7c153..726406f6d 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -32,6 +32,7 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Concats; with Synth.Expr; use Synth.Expr; +with Netlists.Locations; package body Synth.Context is package Packages_Table is new Tables @@ -581,6 +582,13 @@ package body Synth.Context is return Get_Net (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)); + end if; + return Val.C_Net; when others => raise Internal_Error; end case; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index b7aade231..63661a82e 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -405,6 +405,7 @@ package body Synth.Decls is First_Decl : Node; Decl_Type : Node; Val : Value_Acc; + Cst : Value_Acc; Obj_Type : Type_Acc; begin if Deferred_Decl = Null_Node @@ -438,7 +439,8 @@ package body Synth.Decls is -- For constant functions, the value must be constant. pragma Assert (not Get_Instance_Const (Syn_Inst) or else Is_Const (Val)); - Create_Object_Force (Syn_Inst, First_Decl, Val); + Cst := Create_Value_Const (Val, Decl); + Create_Object_Force (Syn_Inst, First_Decl, Cst); end if; end Synth_Constant_Declaration; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index e4e12f6e5..9be6d5182 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -1558,6 +1558,7 @@ package body Synth.Expr is N : Net; begin Res := Synth_Expression (Syn_Inst, Pfx); + Strip_Const (Res); Res_Typ := Res.Typ.Rec.E (Idx + 1).Typ; if Res.Kind = Value_Const_Record then return Res.Rec.V (Idx + 1); diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index dd36ef4aa..d2d4e5cb9 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -409,8 +409,10 @@ package body Synth.Oper is begin Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Typ); Left := Synth_Subtype_Conversion (Left, Left_Typ, False, Expr); + Strip_Const (Left); Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Typ); Right := Synth_Subtype_Conversion (Right, Right_Typ, False, Expr); + Strip_Const (Right); case Def is when Iir_Predefined_Error => @@ -936,6 +938,7 @@ package body Synth.Oper is begin Operand := Synth_Expression_With_Type (Syn_Inst, Operand_Expr, Oper_Typ); Operand := Synth_Subtype_Conversion (Operand, Oper_Typ, False, Loc); + Strip_Const (Operand); case Def is when Iir_Predefined_Error => diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 6ffb56fab..2cc37ce67 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -179,11 +179,14 @@ package body Synth.Stmts is Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Voff); end if; - elsif Dest_Obj.Kind = Value_Const_Array then - Dest_Obj := Dest_Obj.Arr.V - (Iir_Index32 ((Dest_W - Dest_Off) / W)); - Dest_Off := 0; - Dest_W := W; + else + Strip_Const (Dest_Obj); + if Dest_Obj.Kind = Value_Const_Array then + Dest_Obj := Dest_Obj.Arr.V + (Iir_Index32 ((Dest_W - Dest_Off) / W)); + Dest_Off := 0; + Dest_W := W; + end if; end if; end; @@ -195,6 +198,7 @@ package body Synth.Stmts is Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); + Strip_Const (Dest_Obj); Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off; Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ; end; diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 30695afa2..2bbe7dd97 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -56,6 +56,8 @@ package body Synth.Values is return False; when Value_Alias => return Is_Const (Val.A_Obj); + when Value_Const => + return True; when Value_Instance | Value_Subtype => -- Not really a value. @@ -79,6 +81,8 @@ package body Synth.Values is when Value_Array | Value_Record => return False; + when Value_Const => + return True; when Value_Instance | Value_Subtype | Value_Alias => @@ -565,6 +569,27 @@ package body Synth.Values is Typ => Typ))); end Create_Value_Alias; + function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) + return Value_Acc + is + subtype Value_Type_Const is Value_Type (Value_Const); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const); + begin + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Const, + C_Val => Val, + C_Loc => Loc, + C_Net => No_Net, + Typ => Val.Typ))); + end Create_Value_Const; + + procedure Strip_Const (Val : in out Value_Acc) is + begin + if Val.Kind = Value_Const then + Val := Val.C_Val; + end if; + end Strip_Const; + function Copy (Src: in Value_Acc) return Value_Acc is Res: Value_Acc; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 5fc406e9e..93c3d530e 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -19,11 +19,14 @@ -- MA 02110-1301, USA. with Types; use Types; +with Areapools; use Areapools; + with Netlists; use Netlists; + with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Environment; use Synth.Environment; -with Areapools; use Areapools; +with Synth.Environment; use Synth.Environment; +with Synth.Source; use Synth.Source; package Synth.Values is type Discrete_Range_Type is record @@ -158,7 +161,12 @@ package Synth.Values is -- A package. Value_Instance, - -- An alias + -- A constant. This is a named value. One purpose is to avoid to + -- create many times the same net for the same value. + Value_Const, + + -- An alias. This is a reference to another value with a different + -- (but compatible) type. Value_Alias, -- A subtype. Contains only a type. @@ -201,6 +209,10 @@ package Synth.Values is Rec : Value_Array_Acc; when Value_Instance => Instance : Instance_Id; + when Value_Const => + C_Val : Value_Acc; + C_Loc : Syn_Src; + C_Net : Net; when Value_Alias => A_Obj : Value_Acc; A_Off : Uns32; @@ -284,6 +296,11 @@ package Synth.Values is function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) return Value_Acc; + function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) + return Value_Acc; + + -- If VAL is a const, replace it by its value. + procedure Strip_Const (Val : in out Value_Acc); function Unshare (Src : Value_Acc; Pool : Areapool_Acc) return Value_Acc; |