diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-09-16 19:55:00 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-09-16 19:55:00 +0200 |
commit | 2a51f0c5c65d5d71c5abbd0631a0ec5660678520 (patch) | |
tree | a3f077806dced3a7106bf990f589184fbde30d62 /src | |
parent | 7f411fd357bc9a17dc3d0593b86f4b8412a94632 (diff) | |
download | ghdl-2a51f0c5c65d5d71c5abbd0631a0ec5660678520.tar.gz ghdl-2a51f0c5c65d5d71c5abbd0631a0ec5660678520.tar.bz2 ghdl-2a51f0c5c65d5d71c5abbd0631a0ec5660678520.zip |
synth: preliminary work to factorize code
Diffstat (limited to 'src')
-rw-r--r-- | src/simul/simul-vhdl_elab.adb | 18 | ||||
-rw-r--r-- | src/synth/elab-vhdl_decls.adb | 4 | ||||
-rw-r--r-- | src/synth/synth-vhdl_decls.adb | 6 | ||||
-rw-r--r-- | src/synth/synth-vhdl_expr.adb | 3 | ||||
-rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 80 | ||||
-rw-r--r-- | src/synth/synth-vhdl_stmts.ads | 10 |
6 files changed, 69 insertions, 52 deletions
diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb index 01cfc6b9a..89cf9cf17 100644 --- a/src/simul/simul-vhdl_elab.adb +++ b/src/simul/simul-vhdl_elab.adb @@ -423,7 +423,6 @@ package body Simul.Vhdl_Elab is Base : Signal_Index_Type; Typ : Type_Acc; Off : Value_Offsets; - Dyn : Dyn_Name; begin Mark_Expr_Pool (Marker); @@ -432,8 +431,7 @@ package body Simul.Vhdl_Elab is while Is_Valid (It) loop Sig := Get_Element (It); exit when Sig = Null_Node; - Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off); Base := Base_Vt.Val.S; Typ := Unshare (Typ, Global_Pool'Access); @@ -457,7 +455,6 @@ package body Simul.Vhdl_Elab is Base : Signal_Index_Type; Typ : Type_Acc; Off : Value_Offsets; - Dyn : Dyn_Name; begin Mark_Expr_Pool (Marker); @@ -465,8 +462,7 @@ package body Simul.Vhdl_Elab is while Is_Valid (It) loop Sig := Get_Element (It); exit when Sig = Null_Node; - Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off); Base := Base_Vt.Val.S; Typ := Unshare (Typ, Global_Pool'Access); @@ -580,7 +576,6 @@ package body Simul.Vhdl_Elab is Actual_Sig : Signal_Index_Type; Typ : Type_Acc; Off : Value_Offsets; - Dyn : Dyn_Name; Conn : Connect_Entry; List : Iir_List; Formal_Ep, Actual_Ep : Connect_Endpoint; @@ -597,15 +592,13 @@ package body Simul.Vhdl_Elab is Formal := Inter; end if; Synth_Assignment_Prefix - (Port_Inst, Formal, Formal_Base, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + (Port_Inst, Formal, Formal_Base, Typ, Off); Typ := Unshare (Typ, Global_Pool'Access); Formal_Sig := Formal_Base.Val.S; Formal_Ep := (Formal_Sig, Off, Typ); Synth_Assignment_Prefix - (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off); Typ := Unshare (Typ, Global_Pool'Access); Actual_Sig := Actual_Base.Val.S; Actual_Ep := (Actual_Sig, Off, Typ); @@ -666,8 +659,7 @@ package body Simul.Vhdl_Elab is when Iir_Kind_Association_Element_By_Expression => Inter := Get_Association_Interface (Assoc, Assoc_Inter); Synth_Assignment_Prefix - (Port_Inst, Inter, Formal_Base, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + (Port_Inst, Inter, Formal_Base, Typ, Off); Formal_Sig := Formal_Base.Val.S; Formal_Ep := (Formal_Sig, Off, Typ); diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb index d7ceef8e5..5d5f38d25 100644 --- a/src/synth/elab-vhdl_decls.adb +++ b/src/synth/elab-vhdl_decls.adb @@ -295,7 +295,6 @@ package body Elab.Vhdl_Decls is Obj_Typ : Type_Acc; Base : Valtyp; Typ : Type_Acc; - Dyn : Dyn_Name; begin Mark_Expr_Pool (Marker); @@ -307,8 +306,7 @@ package body Elab.Vhdl_Decls is Obj_Typ := null; end if; - Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off, Dyn); - pragma Assert (Dyn = No_Dyn_Name); + Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off); Typ := Unshare (Typ, Instance_Pool); Res := Create_Value_Alias (Base, Off, Typ, Expr_Pool'Access); if Obj_Typ /= null then diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index 36fbf818d..c3945a82c 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -500,7 +500,6 @@ package body Synth.Vhdl_Decls is Atype : constant Node := Get_Declaration_Type (Decl); Marker : Mark_Type; Off : Value_Offsets; - Dyn : Vhdl_Stmts.Dyn_Name; Res : Valtyp; Obj_Typ : Type_Acc; Base : Valtyp; @@ -516,9 +515,8 @@ package body Synth.Vhdl_Decls is Mark_Expr_Pool (Marker); - Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), - Base, Typ, Off, Dyn); - pragma Assert (Dyn.Voff = No_Net); + Vhdl_Stmts.Synth_Assignment_Prefix + (Syn_Inst, Get_Name (Decl), Base, Typ, Off); Typ := Unshare (Typ, Instance_Pool); if Base.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index 99ab99ea2..3775b3f7b 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -2065,7 +2065,8 @@ package body Synth.Vhdl_Expr is Dyn : Dyn_Name; begin - Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Dyn); + Synth_Assignment_Prefix + (Syn_Inst, Syn_Inst, Expr, Base, Typ, Off, Dyn); if Base = No_Valtyp then -- Propagate error. return No_Valtyp; diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index b37cdcc77..199bd86d6 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -101,46 +101,52 @@ package body Synth.Vhdl_Stmts is end Synth_Waveform; procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Inter_Inst : Synth_Instance_Acc; Pfx : Node; Dest_Base : out Valtyp; Dest_Typ : out Type_Acc; Dest_Off : out Value_Offsets; - Dest_Dyn : out Dyn_Name) is + Dest_Dyn : out Dyn_Name) + is + procedure Assign_Base (Inst : Synth_Instance_Acc) + is + Targ : constant Valtyp := Get_Value (Inst, Pfx); + begin + Dest_Dyn := No_Dyn_Name; + Dest_Typ := Targ.Typ; + + if Targ.Val.Kind = Value_Alias then + -- Replace alias by the aliased name. + Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); + Dest_Off := Targ.Val.A_Off; + else + Dest_Base := Targ; + Dest_Off := No_Value_Offsets; + end if; + end Assign_Base; begin case Get_Kind (Pfx) is when Iir_Kind_Simple_Name | Iir_Kind_Attribute_Name => - Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), - Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); + Synth_Assignment_Prefix + (Syn_Inst, Inter_Inst, Get_Named_Entity (Pfx), + Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => + Assign_Base (Inter_Inst); + when Iir_Kind_Variable_Declaration + | Iir_Kind_Signal_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration | Iir_Kind_Non_Object_Alias_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Free_Quantity_Declaration | Iir_Kinds_Branch_Quantity_Declaration | Iir_Kind_Dot_Attribute => - declare - Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx); - begin - Dest_Dyn := No_Dyn_Name; - Dest_Typ := Targ.Typ; - - if Targ.Val.Kind = Value_Alias then - -- Replace alias by the aliased name. - Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); - Dest_Off := Targ.Val.A_Off; - else - Dest_Base := Targ; - Dest_Off := (0, 0); - end if; - end; + Assign_Base (Syn_Inst); when Iir_Kind_Function_Call => Dest_Base := Synth_Expression (Syn_Inst, Pfx); Dest_Typ := Dest_Base.Typ; @@ -155,7 +161,7 @@ package body Synth.Vhdl_Stmts is Err : Boolean; begin Synth_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), + (Syn_Inst, Inter_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Strip_Const (Dest_Base); Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, @@ -197,7 +203,7 @@ package body Synth.Vhdl_Stmts is Get_Element_Position (Get_Named_Entity (Pfx)); begin Synth_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), + (Syn_Inst, Inter_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; @@ -213,7 +219,7 @@ package body Synth.Vhdl_Stmts is Sl_Off : Value_Offsets; begin Synth_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), + (Syn_Inst, Inter_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Strip_Const (Dest_Base); @@ -253,20 +259,33 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => Synth_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), - Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); - if Dest_Off /= (0, 0) and then Dest_Dyn.Voff /= No_Net then + (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); + if Dest_Off /= (0, 0) then raise Internal_Error; end if; Dest_Base := Create_Value_Memtyp (Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Dest_Base))); Dest_Typ := Dest_Base.Typ; + Dest_Dyn := No_Dyn_Name; when others => Error_Kind ("synth_assignment_prefix", Pfx); end case; end Synth_Assignment_Prefix; + procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Pfx : Node; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; + Dest_Off : out Value_Offsets) + is + Dyn : Dyn_Name; + begin + Synth_Assignment_Prefix + (Syn_Inst, Syn_Inst, Pfx, Dest_Base, Dest_Typ, Dest_Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + end Synth_Assignment_Prefix; + function Synth_Aggregate_Target_Type (Syn_Inst : Synth_Instance_Acc; Target : Node) return Type_Acc is @@ -365,7 +384,8 @@ package body Synth.Vhdl_Stmts is Dyn : Dyn_Name; begin - Synth_Assignment_Prefix (Syn_Inst, Target, Base, Typ, Off, Dyn); + Synth_Assignment_Prefix + (Syn_Inst, Syn_Inst, Target, Base, Typ, Off, Dyn); if Dyn.Voff = No_Net then -- FIXME: check index. return Target_Info'(Kind => Target_Simple, @@ -4222,14 +4242,12 @@ package body Synth.Vhdl_Stmts is declare Off : Value_Offsets; - Dyn : Dyn_Name; N : Net; Base : Valtyp; Typ : Type_Acc; begin - Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off, Dyn); + Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off); pragma Assert (Off = (0, 0)); - pragma Assert (Dyn.Voff = No_Net); pragma Assert (Base.Val.Kind = Value_Wire); pragma Assert (Base.Typ = Typ); diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index 092249225..fde8fd8cd 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -75,13 +75,23 @@ package Synth.Vhdl_Stmts is -- DEST_TYP is the type of the result. -- DEST_OFF is the offset, within DEST_DYN. -- DEST_DYN is set (Voff field set) when there is a non-static index. + -- SYN_INST is used for all parts except when PFX is an interface. In the + -- latter, INTER_INST is used. procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Inter_Inst : Synth_Instance_Acc; Pfx : Node; Dest_Base : out Valtyp; Dest_Typ : out Type_Acc; Dest_Off : out Value_Offsets; Dest_Dyn : out Dyn_Name); + -- Simplified version. No dynamic offset expected. + procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Pfx : Node; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; + Dest_Off : out Value_Offsets); + procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Valtyp; |