diff options
Diffstat (limited to 'src')
25 files changed, 980 insertions, 432 deletions
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index 25984a8fa..ac60a49f9 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -1042,6 +1042,8 @@ package body Elab.Vhdl_Insts is pragma Assert (Is_Expr_Pool_Empty); + Top_Instance := Top_Inst; + Elab_Instance_Body (Top_Inst); pragma Assert (Areapools.Is_Empty (Expr_Pool)); diff --git a/src/synth/elab-vhdl_insts.ads b/src/synth/elab-vhdl_insts.ads index 1e78c3329..ca79f762a 100644 --- a/src/synth/elab-vhdl_insts.ads +++ b/src/synth/elab-vhdl_insts.ads @@ -21,6 +21,9 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Elab.Vhdl_Context; use Elab.Vhdl_Context; package Elab.Vhdl_Insts is + -- The result of Elab_Top_Unit, to handle external names. + Top_Instance : Synth_Instance_Acc; + function Elab_Top_Unit (Config : Node) return Synth_Instance_Acc; procedure Elab_Generics_Association (Sub_Inst : Synth_Instance_Acc; diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 0a1a4b982..724e961b5 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -105,13 +105,14 @@ package body Elab.Vhdl_Values is return To_Value_Acc (Alloc (Pool, (Kind => Value_Wire, N => S))); end Create_Value_Wire; - function Create_Value_Net (S : Uns32) return Value_Acc + function Create_Value_Net (S : Uns32; Pool : Areapool_Acc) + 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 return To_Value_Acc - (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => S))); + (Alloc (Pool, Value_Type_Net'(Kind => Value_Net, N => S))); end Create_Value_Net; function Create_Value_Signal (S : Signal_Index_Type; Init : Value_Acc) @@ -306,7 +307,7 @@ package body Elab.Vhdl_Values is Res := Create_Value_Memory (Src.Typ, Current_Pool); Copy_Memory (Res.Val.Mem, Src.Val.Mem, Src.Typ.Sz); when Value_Net => - Res := (Src.Typ, Create_Value_Net (Src.Val.N)); + Res := (Src.Typ, Create_Value_Net (Src.Val.N, Current_Pool)); when Value_Wire => Res := (Src.Typ, Create_Value_Wire (Src.Val.N, Current_Pool)); when Value_File => diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 21ea4a35b..c4482c71c 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -140,7 +140,8 @@ package Elab.Vhdl_Values is function Is_Equal (L, R : Valtyp) return Boolean; -- Create a Value_Net. - function Create_Value_Net (S : Uns32) return Value_Acc; + function Create_Value_Net (S : Uns32; Pool : Areapool_Acc) + return Value_Acc; -- Create a Value_Wire. function Create_Value_Wire (S : Uns32; Pool : Areapool_Acc) diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads index b496111ae..e5ad1a052 100644 --- a/src/synth/netlists-gates.ads +++ b/src/synth/netlists-gates.ads @@ -119,6 +119,10 @@ package Netlists.Gates is -- by a gate (and thus the value of the output could be read), but that -- driving value may not be available early enough. -- Id_Ioutput is an output with an initial value. + -- + -- Inputs: 0: driver + -- 1: initial value (if any) + -- Output: 0: value Id_Signal : constant Module_Id := 52; Id_Isignal : constant Module_Id := 53; Id_Output : constant Module_Id := 54; diff --git a/src/synth/netlists-memories.adb b/src/synth/netlists-memories.adb index 84267ea44..8e62137e6 100644 --- a/src/synth/netlists-memories.adb +++ b/src/synth/netlists-memories.adb @@ -438,7 +438,8 @@ package body Netlists.Memories is -- Return True iff MUX_INP is a mux2 input whose output is connected to a -- dff to create a DFF with enable (the other mux2 input is connected to -- the dff output). - function Is_Enable_Dff (Mux_Inp : Input) return Boolean + procedure Is_Enable_Dff + (Mux_Inp : Input; Res : out Boolean; Inv : out Boolean) is Mux_Inst : constant Instance := Get_Input_Parent (Mux_Inp); pragma Assert (Get_Id (Mux_Inst) = Id_Mux2); @@ -446,42 +447,56 @@ package body Netlists.Memories is Inp : Input; Dff_Inst : Instance; Dff_Out : Net; + Prt : Port_Idx; begin + Inv := False; + Res := False; + Inp := Get_First_Sink (Mux_Out); if Inp = No_Input or else Get_Next_Sink (Inp) /= No_Input then -- The output of the mux must be connected to one input. - return False; + return; end if; + + -- Check if the mux is before a dff. Dff_Inst := Get_Input_Parent (Inp); if Get_Id (Dff_Inst) /= Id_Dff then - return False; + return; end if; + Dff_Out := Get_Output (Dff_Inst, 0); if Mux_Inp = Get_Input (Mux_Inst, 1) then - return Skip_Signal (Get_Input_Net (Mux_Inst, 2)) = Dff_Out; + -- Loop on sel = 1 (so enable is inverted). + Inv := True; + Prt := 2; else - return Skip_Signal (Get_Input_Net (Mux_Inst, 1)) = Dff_Out; + -- Loop on sel = 0. + Prt := 1; end if; + Res := Skip_Signal (Get_Input_Net (Mux_Inst, Prt)) = Dff_Out; end Is_Enable_Dff; - -- INST is a Dyn_Extract. - -- If INST is followed by a dff or a dff+enable (with mux2), return the - -- dff in LAST_INST, the clock in CLK and the enable in EN. + -- EXTR_INST is a Dyn_Extract. + -- If EXTR_INST is followed by a dff or a dff+enable (with mux2), + -- return the dff in LAST_INST, the clock in CLK and the enable in EN. procedure Extract_Extract_Dff (Ctxt : Context_Acc; - Inst : Instance; + Extr_Inst : Instance; Last_Inst : out Instance; Clk : out Net; En : out Net) is - Val : constant Net := Get_Output (Inst, 0); + Val : constant Net := Get_Output (Extr_Inst, 0); Inp : Input; Iinst : Instance; + Is_Dff : Boolean; + Is_Inv : Boolean; begin Inp := Get_First_Sink (Val); if Get_Next_Sink (Inp) = No_Input then - -- There is a single input. + -- The output of INST (a Dyn_Extract) goes to only one gate. Iinst := Get_Input_Parent (Inp); + if Get_Id (Iinst) = Id_Dff then -- The output of the dyn_extract is directly connected to a dff. -- So this is a synchronous read without enable. @@ -496,7 +511,13 @@ package body Netlists.Memories is Last_Inst := Iinst; return; end; - elsif Get_Id (Iinst) = Id_Mux2 and then Is_Enable_Dff (Inp) then + end if; + if Get_Id (Iinst) = Id_Mux2 then + Is_Enable_Dff (Inp, Is_Dff, Is_Inv); + else + Is_Dff := False; + end if; + if Is_Dff then declare Mux_Out : constant Net := Get_Output (Iinst, 0); Mux_En_Inp : constant Input := Get_Input (Iinst, 0); @@ -504,12 +525,11 @@ package body Netlists.Memories is Mux_I1_Inp : constant Input := Get_Input (Iinst, 2); Dff_Din : constant Input := Get_First_Sink (Mux_Out); Dff_Inst : constant Instance := Get_Input_Parent (Dff_Din); - Dff_Out : constant Net := Get_Output (Dff_Inst, 0); Clk_Inp : constant Input := Get_Input (Dff_Inst, 0); begin Clk := Get_Driver (Clk_Inp); En := Get_Driver (Mux_En_Inp); - if Dff_Out = Get_Driver (Mux_I1_Inp) then + if Is_Inv then En := Build_Monadic (Ctxt, Id_Not, En); Copy_Location (En, Iinst); end if; @@ -525,7 +545,7 @@ package body Netlists.Memories is end if; end if; - Last_Inst := Inst; + Last_Inst := Extr_Inst; Clk := No_Net; En := No_Net; end Extract_Extract_Dff; @@ -1019,89 +1039,43 @@ package body Netlists.Memories is -- VAL is the output of the dyn_extract. -- -- Infere a synchronous read if the dyn_extract is connected to a dff. - function Create_ROM_Read_Port - (Ctxt : Context_Acc; Last : Net; Addr : Net; Val : Net; Step : Width) - return Instance + function Create_ROM_Read_Port (Ctxt : Context_Acc; + Last : Net; + Addr : Net; + Extr_Inst : Instance; + Step : Width) return Instance is + Val : constant Net := Get_Output (Extr_Inst, 0); W : constant Width := Get_Width (Val); Res : Instance; - Inp : Input; - Iinst : Instance; + Dff_Inst : Instance; N : Net; + Clk : Net; + En : Net; begin - Inp := Get_First_Sink (Val); - if Get_Next_Sink (Inp) = No_Input then - -- There is a single input. - Iinst := Get_Input_Parent (Inp); - if Get_Id (Iinst) = Id_Dff then - -- The output of the dyn_extract is directly connected to a dff. - -- So this is a synchronous read without enable. - declare - Clk_Inp : Input; - Clk : Net; - En : Net; - begin - Clk_Inp := Get_Input (Iinst, 0); - Clk := Get_Driver (Clk_Inp); - Disconnect (Clk_Inp); - En := Build_Const_UB32 (Ctxt, 1, 1); - Disconnect (Inp); - Res := Build_Mem_Rd_Sync (Ctxt, Last, Addr, Clk, En, Step); - - -- Slice the output. - N := Get_Output (Res, 1); - N := Build2_Extract (Ctxt, N, 0, W); - - Redirect_Inputs (Get_Output (Iinst, 0), N); - Remove_Instance (Iinst); - return Res; - end; - elsif Get_Id (Iinst) = Id_Mux2 and then Is_Enable_Dff (Inp) then - declare - Mux_Out : constant Net := Get_Output (Iinst, 0); - Mux_En_Inp : constant Input := Get_Input (Iinst, 0); - Mux_I0_Inp : constant Input := Get_Input (Iinst, 1); - Mux_I1_Inp : constant Input := Get_Input (Iinst, 2); - Dff_Din : constant Input := Get_First_Sink (Mux_Out); - Dff_Inst : constant Instance := Get_Input_Parent (Dff_Din); - Dff_Out : constant Net := Get_Output (Dff_Inst, 0); - Clk_Inp : constant Input := Get_Input (Dff_Inst, 0); - Clk : constant Net := Get_Driver (Clk_Inp); - En : Net; - begin - En := Get_Driver (Mux_En_Inp); - if Dff_Out = Get_Driver (Mux_I1_Inp) then - En := Build_Monadic (Ctxt, Id_Not, En); - Copy_Location (En, Dff_Inst); - end if; - Disconnect (Mux_En_Inp); - Disconnect (Mux_I0_Inp); - Disconnect (Mux_I1_Inp); - Disconnect (Dff_Din); - Disconnect (Clk_Inp); - Remove_Instance (Iinst); - Res := Build_Mem_Rd_Sync (Ctxt, Last, Addr, Clk, En, Step); - Set_Location (Res, Get_Location (Dff_Inst)); - - -- Slice the output. - N := Get_Output (Res, 1); - N := Build2_Extract (Ctxt, N, 0, W); - - Redirect_Inputs (Dff_Out, N); - Remove_Instance (Dff_Inst); - return Res; - end; + Extract_Extract_Dff (Ctxt, Extr_Inst, Dff_Inst, Clk, En); + if Dff_Inst /= Extr_Inst then + -- There was a dff, so the read port is synchronous. + if En = No_Net then + En := Build_Const_UB32 (Ctxt, 1, 1); end if; - end if; - -- Replace Dyn_Extract with mem_rd. - Res := Build_Mem_Rd (Ctxt, Last, Addr, Step); + Res := Build_Mem_Rd_Sync (Ctxt, Last, Addr, Clk, En, Step); + else + -- Replace Dyn_Extract with mem_rd (asynchronous read port). + Res := Build_Mem_Rd (Ctxt, Last, Addr, Step); + end if; -- Slice the output. N := Get_Output (Res, 1); N := Build2_Extract (Ctxt, N, 0, W); - Redirect_Inputs (Val, N); + if Dff_Inst /= Extr_Inst then + Redirect_Inputs (Get_Output (Dff_Inst, 0), N); + Remove_Instance (Dff_Inst); + else + Redirect_Inputs (Get_Output (Extr_Inst, 0), N); + end if; return Res; end Create_ROM_Read_Port; @@ -1117,7 +1091,6 @@ package body Netlists.Memories is Extr_Inst : Instance; Addr_Inp : Input; Addr : Net; - Val : Net; Port_Inst : Instance; begin Last := Get_Output (Mem_Inst, 0); @@ -1142,11 +1115,11 @@ package body Netlists.Memories is Addr_Inp := Get_Input (Extr_Inst, 1); Addr := Get_Driver (Addr_Inp); Disconnect (Addr_Inp); - Val := Get_Output (Extr_Inst, 0); Convert_Memidx (Ctxt, Orig, Addr, Step); -- Replace Dyn_Extract with mem_rd. - Port_Inst := Create_ROM_Read_Port (Ctxt, Last, Addr, Val, Step); + Port_Inst := Create_ROM_Read_Port + (Ctxt, Last, Addr, Extr_Inst, Step); Remove_Instance (Extr_Inst); diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index d6b48ec88..bd68aa39f 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -770,12 +770,19 @@ package body Synth.Environment is function Is_Tribuf_Net (N : Net) return Boolean is use Netlists.Gates; + Inst : constant Instance := Get_Net_Parent (N); begin - case Get_Id (Get_Net_Parent (N)) is + case Get_Id (Inst) is when Id_Tri - | Id_Resolver - | Id_Port => + | Id_Resolver + | Id_Const_Z => + return True; + when Id_Port => + -- We don't know, so assume yes. return True; + when Id_Signal + | Id_Isignal => + return Is_Tribuf_Net (Get_Input_Net (Inst, 0)); when others => return False; end case; diff --git a/src/synth/synth-flags.ads b/src/synth/synth-flags.ads index aa3a0b8aa..541663543 100644 --- a/src/synth/synth-flags.ads +++ b/src/synth/synth-flags.ads @@ -74,6 +74,11 @@ package Synth.Flags is -- Synthesize PSL and assertions. Flag_Formal : Boolean := True; + -- True to keep hierarchy: an module/entity instantiation is synthesized + -- as an instantiation. + -- If false, the netlist is flat. + Flag_Keep_Hierarchy : Boolean := True; + -- If true, automatically add a cover on PSL asserts to know if the -- asserted has been started. Flag_Assert_Cover : Boolean := True; diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 55f9f795d..81898157f 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -384,18 +384,16 @@ package body Synth.Vhdl_Context is return (Wtype, Create_Value_Wire (W, Pool)); end Create_Value_Wire; - function Create_Value_Net (N : Net) return Value_Acc + function Create_Value_Net (N : Net; Pool : Areapool_Acc) return Value_Acc is function To_Uns32 is new Ada.Unchecked_Conversion (Net, Uns32); begin - return Create_Value_Net (To_Uns32 (N)); + return Create_Value_Net (To_Uns32 (N), Pool); end Create_Value_Net; - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp - is - pragma Assert (Ntype /= null); + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp is begin - return (Ntype, Create_Value_Net (N)); + return (Ntype, Create_Value_Net (N, Current_Pool)); end Create_Value_Net; function Create_Value_Dyn_Alias (Obj : Value_Acc; diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads index 396f0718d..94dc401d4 100644 --- a/src/synth/synth-vhdl_context.ads +++ b/src/synth/synth-vhdl_context.ads @@ -104,6 +104,7 @@ package Synth.Vhdl_Context is pragma Inline (Set_Value_Wire); -- Create a Value_Net. + function Create_Value_Net (N : Net; Pool : Areapool_Acc) 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. diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index 19473775f..f1e42c97b 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -659,12 +659,12 @@ package body Synth.Vhdl_Decls is if Aval.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the -- bits for the alias. - Current_Pool := Instance_Pool; - Aval := Create_Value_Net - (Build2_Extract (Get_Build (Syn_Inst), Get_Value_Net (Aval.Val), - Off, Val.Typ.W), - Val.Typ); - Current_Pool := Expr_Pool'Access; + Aval := (Val.Typ, + Create_Value_Net (Build2_Extract + (Get_Build (Syn_Inst), + Get_Value_Net (Aval.Val), + Off, Val.Typ.W), + Instance_Pool)); Val.Val.A_Off := (0, 0); else Aval := Unshare (Aval, Instance_Pool); @@ -844,6 +844,14 @@ package body Synth.Vhdl_Decls is Finalize_Assignment (Get_Build (Syn_Inst), W); Gate_Net := Get_Wire_Gate (W); + + Free_Wire (W); + + -- Replace the wire with a net so that external names can refer to it. + Mutate_Object + (Syn_Inst, Decl, + (Vt.Typ, Create_Value_Net (Gate_Net, Process_Pool'Access))); + Gate := Get_Net_Parent (Gate_Net); case Get_Id (Gate) is when Id_Signal @@ -883,8 +891,6 @@ package body Synth.Vhdl_Decls is -- The value of an undriven signal is its initial value. Connect (Get_Input (Gate, 0), Def_Val); end if; - - Free_Wire (W); end Finalize_Signal; procedure Finalize_Declaration diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb index 020c67896..1913f349a 100644 --- a/src/synth/synth-vhdl_eval.adb +++ b/src/synth/synth-vhdl_eval.adb @@ -609,6 +609,7 @@ package body Synth.Vhdl_Eval is end case; end Eval_Vector_Minimum; + -- ARG to log-vector, sign extended. function Eval_To_Log_Vector (Arg : Uns64; Sz : Int64; Res_Type : Type_Acc) return Memtyp is @@ -2634,7 +2635,8 @@ package body Synth.Vhdl_Eval is (Uns64 (Read_Discrete (Param1)), Int64 (Param2.Typ.Abound.Len), Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Nat_Sgn - | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int => + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Int => return Eval_To_Log_Vector (To_Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), Res_Typ); diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index b5093cb02..c73b2133e 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -41,6 +41,7 @@ with Elab.Vhdl_Annotations; with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; with Elab.Vhdl_Types; use Elab.Vhdl_Types; with Elab.Vhdl_Expr; +with Elab.Vhdl_Insts; with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Environment; @@ -830,6 +831,114 @@ package body Synth.Vhdl_Expr is end case; end Synth_Subtype_Conversion; + function Synth_Pathname (Loc_Inst : Synth_Instance_Acc; + Name : Node; + Cur_Inst : Synth_Instance_Acc; + Path : Node) return Valtyp + is + Suffix : constant Node := Get_Pathname_Suffix (Path); + Id : constant Name_Id := Get_Identifier (Path); + Scope : constant Node := Get_Source_Scope (Cur_Inst); + Res : Node; + begin + if Suffix = Null_Node then + -- Object simple name. + case Get_Kind (Scope) is + when Iir_Kind_Architecture_Body => + Res := Find_Name_In_Chain (Get_Declaration_Chain (Scope), Id); + when others => + Error_Kind ("synth_pathname(obj)", Scope); + end case; + if Res = Null_Node then + Error_Msg_Synth + (Loc_Inst, Path, "cannot find object %i in %i", (+Id, +Scope)); + return No_Valtyp; + end if; + case Get_Kind (Res) is + when Iir_Kind_Signal_Declaration => + case Iir_Kinds_External_Name (Get_Kind (Name)) is + when Iir_Kind_External_Signal_Name => + return Get_Value (Cur_Inst, Res); + when Iir_Kind_External_Constant_Name + | Iir_Kind_External_Variable_Name => + Error_Msg_Synth + (Loc_Inst, Path, "object name %i is a signal", +Res); + return No_Valtyp; + end case; + when others => + Error_Kind ("synth_pathname(1)", Res); + end case; + else + -- Find name in concurrent statements. + case Get_Kind (Scope) is + when Iir_Kind_Architecture_Body => + Res := Find_Name_In_Chain + (Get_Concurrent_Statement_Chain (Scope), Id); + when others => + Error_Kind ("synth_pathname(scope)", Scope); + end case; + if Res = Null_Node then + Error_Msg_Synth + (Loc_Inst, Path, + "cannot find path element %i in %i", (+Id, +Scope)); + return No_Valtyp; + end if; + case Get_Kind (Res) is + when Iir_Kind_Component_Instantiation_Statement => + if Is_Entity_Instantiation (Res) then + return Synth_Pathname + (Loc_Inst, Name, Get_Sub_Instance (Cur_Inst, Res), Suffix); + else + -- TODO: skip component. + raise Internal_Error; + end if; + when others => + Error_Kind ("synth_pathname(2)", Res); + end case; + end if; + end Synth_Pathname; + + function Synth_Absolute_Pathname + (Syn_Inst : Synth_Instance_Acc; Name : Node; Path : Node) return Valtyp + is + Path_Inst : constant Synth_Instance_Acc := Elab.Vhdl_Insts.Top_Instance; + Top_Arch : constant Node := Get_Source_Scope (Path_Inst); + Top_Ent : constant Node := Get_Entity (Top_Arch); + Suffix : constant Node := Get_Pathname_Suffix (Path); + begin + if Get_Identifier (Top_Ent) /= Get_Identifier (Suffix) then + Error_Msg_Synth + (Syn_Inst, Path, + "root %i of absolute pathname is not the top entity %i", + (+Top_Ent, +Suffix)); + return No_Valtyp; + end if; + + return Synth_Pathname + (Syn_Inst, Name, Path_Inst, Get_Pathname_Suffix (Suffix)); + end Synth_Absolute_Pathname; + + function Synth_External_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Valtyp + is + Path : Node; + Res : Valtyp; + begin + Path := Get_External_Pathname (Name); + case Get_Kind (Path) is + when Iir_Kind_Absolute_Pathname => + Res := Synth_Absolute_Pathname (Syn_Inst, Name, Path); + when others => + Error_Kind ("synth_external_name", Path); + end case; + if Res = No_Valtyp then + return No_Valtyp; + end if; + + -- TODO: type. + return Res; + end Synth_External_Name; + function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp is begin @@ -854,6 +963,8 @@ package body Synth.Vhdl_Expr is | Iir_Kind_File_Declaration | Iir_Kind_Interface_File_Declaration => return Get_Value (Syn_Inst, Name); + when Iir_Kind_External_Signal_Name => + return Synth_External_Name (Syn_Inst, Name); when Iir_Kind_Attribute_Value => -- It's a little bit complex for attribute of an entity or -- of an architecture as there might be no instances for them. @@ -2041,7 +2152,6 @@ package body Synth.Vhdl_Expr is Set_Location (Res, Call); return Create_Value_Net (Res, Boolean_Type); - end Synth_Psl_Stable; function Synth_Psl_Rose (Syn_Inst : Synth_Instance_Acc; Call : Node) @@ -2072,7 +2182,6 @@ package body Synth.Vhdl_Expr is Set_Location (Res, Call); return Create_Value_Net (Res, Boolean_Type); - end Synth_Psl_Rose; function Synth_Psl_Fell (Syn_Inst : Synth_Instance_Acc; Call : Node) @@ -2102,7 +2211,6 @@ package body Synth.Vhdl_Expr is Set_Location (Res, Call); return Create_Value_Net (Res, Boolean_Type); - end Synth_Psl_Fell; function Synth_Onehot0 (Ctxt : Context_Acc; DffCurr : Net; Call : Node; @@ -2358,6 +2466,7 @@ package body Synth.Vhdl_Expr is | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Object_Alias_Declaration -- For PSL | Iir_Kind_Non_Object_Alias_Declaration -- For PSL + | Iir_Kind_External_Signal_Name | Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => declare diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index 2a20d06a9..35c8ac392 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -60,6 +60,10 @@ with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Insts is Global_Base_Instance : Base_Instance_Acc; + procedure Synth_Instance_Design (Syn_Inst : Synth_Instance_Acc; + Entity : Node; + Arch : Node); + function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is begin case Mode is @@ -479,7 +483,9 @@ package body Synth.Vhdl_Insts is Inter := Get_Chain (Inter); end loop; - -- Allocate values and count inputs and outputs + -- There are already valtyp for ports (created during elab), but they + -- are signals. Convert ports valtyp to nets/wires. + -- Count inputs and outputs. Inter := Get_Port_Chain (Decl); Nbr_Inputs := 0; Nbr_Outputs := 0; @@ -818,7 +824,8 @@ package body Synth.Vhdl_Insts is procedure Synth_Individual_Output_Assoc (Outp : Net; Syn_Inst : Synth_Instance_Acc; Inter_Typ : Type_Acc; - Assoc : Node) + Assoc : Node; + Add_Port : Boolean) is Marker : Mark_Type; Iassoc : Node; @@ -830,8 +837,12 @@ package body Synth.Vhdl_Insts is begin Mark_Expr_Pool (Marker); - Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); - Set_Location (Port, Assoc); + if Add_Port then + Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); + Set_Location (Port, Assoc); + else + Port := Outp; + end if; Iassoc := Get_Chain (Assoc); while Iassoc /= Null_Node @@ -855,14 +866,16 @@ package body Synth.Vhdl_Insts is end loop; end Synth_Individual_Output_Assoc; + -- Associate output according to ASSOC. + -- If ADD_PORT is true, a port gate is added. procedure Synth_Output_Assoc (Outp : Net; Syn_Inst : Synth_Instance_Acc; Assoc : Node; Inter_Inst : Synth_Instance_Acc; - Inter : Node) + Inter : Node; + Add_Port : Boolean) is Marker : Mark_Type; - Actual : Node; Formal_Typ : Type_Acc; Port : Net; O : Valtyp; @@ -872,23 +885,24 @@ package body Synth.Vhdl_Insts is case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => -- Not connected. - return; + null; when Iir_Kinds_Association_Element_By_Actual => - Actual := Get_Actual (Assoc); + Mark_Expr_Pool (Marker); + -- Create a port gate (so that is has a name). + if Add_Port then + Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); + Set_Location (Port, Assoc); + else + Port := Outp; + end if; + O := Create_Value_Net (Port, Formal_Typ); + -- Assign the port output to the actual (a net). + Synth_Assignment (Syn_Inst, Get_Actual (Assoc), O, Assoc); + Release_Expr_Pool (Marker); when others => Synth_Individual_Output_Assoc - (Outp, Syn_Inst, Formal_Typ, Assoc); - return; + (Outp, Syn_Inst, Formal_Typ, Assoc, Add_Port); end case; - - Mark_Expr_Pool (Marker); - -- Create a port gate (so that is has a name). - Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); - Set_Location (Port, Assoc); - O := Create_Value_Net (Port, Formal_Typ); - -- Assign the port output to the actual (a net). - Synth_Assignment (Syn_Inst, Actual, O, Assoc); - Release_Expr_Pool (Marker); end Synth_Output_Assoc; procedure Inst_Input_Connect (Syn_Inst : Synth_Instance_Acc; @@ -1013,7 +1027,7 @@ package body Synth.Vhdl_Insts is (Syn_Inst, Inst, Nbr_Outputs, Inter_Typ, N); Synth_Output_Assoc - (N, Syn_Inst, Assoc, Ent_Inst, Inter); + (N, Syn_Inst, Assoc, Ent_Inst, Inter, True); end case; pragma Assert (Areapools.Is_At_Mark (Expr_Pool, Marker)); @@ -1113,6 +1127,106 @@ package body Synth.Vhdl_Insts is pragma Assert (Is_Expr_Pool_Empty); end Synth_Direct_Instantiation_Statement; + procedure Synth_Flat_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; + Stmt : Node; + Sub_Inst : Synth_Instance_Acc; + Entity : Node; + Arch : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Inter : Node; + Inter_Typ : Type_Acc; + Val : Valtyp; + N : Net; + Name : Sname; + Wid : Wire_Id; + begin + pragma Assert (Is_Expr_Pool_Empty); + + Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); + Set_Extra (Sub_Inst, Syn_Inst, Name); + + -- There are already valtyp for ports (created during elab), but they + -- are signals. Convert ports valtyp to nets/wires. + Inter := Get_Port_Chain (Entity); + Current_Pool := Process_Pool'Access; + while Is_Valid (Inter) loop + Inter_Typ := Get_Value (Sub_Inst, Inter).Typ; + + Name := New_Sname_User (Get_Identifier (Inter), Get_Sname (Sub_Inst)); + N := Build_Signal + (Ctxt, New_Internal_Name (Ctxt, Name), Get_Type_Width (Inter_Typ)); + Set_Location (N, Inter); + + case Mode_To_Port_Kind (Get_Mode (Inter)) is + when Port_In => + -- TODO: default value (isignal). + Val := Create_Value_Net (N, Inter_Typ); + when Port_Out + | Port_Inout => + Wid := Alloc_Wire (Wire_Output, (Inter, Inter_Typ)); + Set_Wire_Gate (Wid, N); + Val := Create_Value_Wire (Wid, Inter_Typ, Current_Pool); + end case; + Replace_Signal (Sub_Inst, Inter, Val); + Inter := Get_Chain (Inter); + end loop; + Current_Pool := Expr_Pool'Access; + + -- Connections. + Push_Phi; + + declare + Marker : Mark_Type; + + Assoc : Node; + Assoc_Inter : Node; + Inter : Node; + Inter_Typ : Type_Acc; + N : Net; + Vt : Valtyp; + Inst : Instance; + begin + Mark_Expr_Pool (Marker); + + Assoc := Get_Port_Map_Aspect_Chain (Stmt); + Assoc_Inter := Get_Port_Chain (Entity); + while Is_Valid (Assoc) loop + if Get_Whole_Association_Flag (Assoc) then + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + Inter_Typ := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); + Vt := Get_Value (Sub_Inst, Inter); + + case Mode_To_Port_Kind (Get_Mode (Inter)) is + when Port_In => + -- Connect the net to the input. + N := Synth_Input_Assoc + (Syn_Inst, Assoc, Sub_Inst, Inter, Inter_Typ); + if N /= No_Net then + -- Ignore errors. + Inst := Get_Net_Parent (Get_Value_Net (Vt.Val)); + Connect (Get_Input (Inst, 0), N); + end if; + + when Port_Out + | Port_Inout => + N := Get_Wire_Gate (Get_Value_Wire (Vt.Val)); + Synth_Output_Assoc + (N, Syn_Inst, Assoc, Sub_Inst, Inter, False); + end case; + + Release_Expr_Pool (Marker); + end if; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end; + + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); + + Synth_Instance_Design (Sub_Inst, Entity, Arch); + end Synth_Flat_Instantiation_Statement; + procedure Synth_Design_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is @@ -1122,8 +1236,20 @@ package body Synth.Vhdl_Insts is Ent : constant Node := Get_Entity (Arch); Config : constant Node := Get_Instance_Config (Sub_Inst); begin - Synth_Direct_Instantiation_Statement - (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config); + if Flag_Keep_Hierarchy then + Synth_Direct_Instantiation_Statement + (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config); + else + -- Dependencies + -- Set files root dir + -- Create name prefix + -- Build ports + -- For in: net + -- For out/inout: wires + -- Connect + Synth_Flat_Instantiation_Statement + (Syn_Inst, Stmt, Sub_Inst, Ent, Arch); + end if; end Synth_Design_Instantiation_Statement; procedure Synth_Blackbox_Instantiation_Statement @@ -1301,7 +1427,8 @@ package body Synth.Vhdl_Insts is if Mode_To_Port_Kind (Get_Mode (Inter)) = Port_Out then O := Get_Value (Comp_Inst, Inter); Port := Get_Net (Ctxt, O); - Synth_Output_Assoc (Port, Syn_Inst, Assoc, Comp_Inst, Inter); + Synth_Output_Assoc + (Port, Syn_Inst, Assoc, Comp_Inst, Inter, True); Nbr_Outputs := Nbr_Outputs + 1; end if; end if; @@ -1444,7 +1571,7 @@ package body Synth.Vhdl_Insts is N : Net; begin pragma Assert (Val.Val.Kind = Value_Net); - N := Get_Value_Net (Val.Val); + -- Get the net from the port(s). Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, N); Set_Value_Net (Val.Val, N); end Create_Input_Wire; @@ -1526,6 +1653,60 @@ package body Synth.Vhdl_Insts is end loop; end Synth_Verification_Units; + procedure Synth_Instance_Design (Syn_Inst : Synth_Instance_Acc; + Entity : Node; + Arch : Node) + is + begin + -- Entity + Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); + if not Is_Error (Syn_Inst) then + Synth_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + if not Is_Error (Syn_Inst) then + Synth_Attribute_Values (Syn_Inst, Entity); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + -- Architecture + if not Is_Error (Syn_Inst) then + Synth_Concurrent_Declarations + (Syn_Inst, Get_Declaration_Chain (Arch)); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + if not Is_Error (Syn_Inst) then + Synth_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + if not Is_Error (Syn_Inst) then + Synth_Attribute_Values (Syn_Inst, Arch); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + -- Vunits + if not Is_Error (Syn_Inst) then + Synth_Verification_Units (Syn_Inst); + end if; + + pragma Assert (Is_Expr_Pool_Empty); + + -- Finalize + Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); + Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity)); + end Synth_Instance_Design; + procedure Synth_Instance (Inst : Inst_Object) is Entity : constant Node := Inst.Decl; @@ -1586,53 +1767,7 @@ package body Synth.Vhdl_Insts is -- FIXME: what about inner block configuration ? pragma Assert (Get_Kind (Inst.Config) = Iir_Kind_Block_Configuration); - -- Entity - Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); - if not Is_Error (Syn_Inst) then - Synth_Concurrent_Statements - (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - if not Is_Error (Syn_Inst) then - Synth_Attribute_Values (Syn_Inst, Entity); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - -- Architecture - if not Is_Error (Syn_Inst) then - Synth_Concurrent_Declarations - (Syn_Inst, Get_Declaration_Chain (Arch)); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - if not Is_Error (Syn_Inst) then - Synth_Concurrent_Statements - (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - if not Is_Error (Syn_Inst) then - Synth_Attribute_Values (Syn_Inst, Arch); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - -- Vunits - if not Is_Error (Syn_Inst) then - Synth_Verification_Units (Syn_Inst); - end if; - - pragma Assert (Is_Expr_Pool_Empty); - - -- Finalize - Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); - Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); - Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity)); + Synth_Instance_Design (Syn_Inst, Entity, Arch); Finalize_Wires; diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index d9f1c694e..64d2deae3 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -2039,7 +2039,8 @@ package body Synth.Vhdl_Oper is return Synth_Resize (Ctxt, L, B.Len, False, Expr); end; when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Nat_Sgn - | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int => + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Int => return Synth_Conv_Vector (True); when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Integer_Slv_Nat @@ -2060,7 +2061,10 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Log + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Log + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Ext => + -- Unsigned to unsigned (resize) declare W : Width; begin @@ -2090,6 +2094,7 @@ package body Synth.Vhdl_Oper is when Iir_Predefined_Ieee_Numeric_Std_Resize_Sgn_Nat | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Sgn | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Sgn + | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Sgn | Iir_Predefined_Ieee_Std_Logic_Arith_Sxt => if not Is_Static (R.Val) then Error_Msg_Synth diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 6a6285a96..6fb438356 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -990,10 +990,11 @@ package body Synth.Vhdl_Stmts is Mark_Expr_Pool (Marker); Targ := Synth_Target (Inst, Get_Target (Stmt)); Targ_Type := Targ.Targ_Type; + First := No_Valtyp; Last := No_Net; Ce := Get_Conditional_Expression_Chain (Stmt); - while Ce /= Null_Node loop + loop -- First, evaluate the condition. Cond := Get_Condition (Ce); if Cond /= Null_Node then @@ -1050,8 +1051,21 @@ package body Synth.Vhdl_Stmts is exit when Cond_Tri = True; Ce := Get_Chain (Ce); + exit when Ce = Null_Node; end loop; - Synth_Assignment (Inst, Targ, First, Stmt); + + if Last /= No_Net then + if Cond_Tri /= True then + -- There is at least one Mux2, and its input-1 is not connected. + -- Implement missing assignment as a self-assignment. + Val := Synth_Read (Inst, Targ, Stmt); + Connect (Get_Input (Get_Net_Parent (Last), 1), + Get_Net (Ctxt, Val)); + end if; + + Synth_Assignment (Inst, Targ, First, Stmt); + end if; + Release_Expr_Pool (Marker); end Synth_Conditional_Variable_Assignment; diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index f48695d95..8533e5483 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -172,7 +172,7 @@ package body Trans.Chap1 is -- Entity declaration subprograms as they can be called by the -- architectures. Chap4.Translate_Declaration_Chain_Subprograms - (Entity, Subprg_Translate_Spec_And_Body); + (Entity, Subprg_Translate_Only_Spec); else -- Entity declaration and process subprograms. Chap9.Translate_Block_Subprograms (Entity, Entity); diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index f3686ef9c..adabd133b 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -654,7 +654,7 @@ package body Trans.Chap12 is case Get_Kind (Lib_Unit) is when Iir_Kind_Package_Declaration => if not Get_Elab_Flag (Unit) then - Chap2.Elab_Package_Body (Lib_Unit, Null_Iir); + Chap2.Elab_Package_Unit_Without_Body (Lib_Unit); end if; when Iir_Kind_Entity_Declaration => Gen_Last_Arch (Lib_Unit); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index e2a2cc398..4c5f15929 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -35,6 +35,8 @@ package body Trans.Chap2 is use Trans.Subprgs; use Trans.Helpers; + procedure Elab_Package_Internal (Spec : Iir; Header : Iir); + type Name_String_Xlat_Array is array (Name_Id range <>) of String (1 .. 4); -- Ortho function names are only composed of [A-Za-z0-9_]. For VHDL @@ -762,155 +764,298 @@ package body Trans.Chap2 is Pop_Instance_Factory (Info.Package_Body_Scope'Access); end Pop_Package_Instance_Factory; - -- Translate a package declaration or a macro-expanded package - -- instantiation. HEADER is the node containing generic and generic_map. - procedure Translate_Package (Decl : Iir; Header : Iir) + -- Declare elaboration routines for a package. + procedure Create_Package_Elaborator (Info : Ortho_Info_Acc) is - Is_Nested : constant Boolean := Is_Nested_Package (Decl); - Is_Uninstantiated : constant Boolean := - Get_Kind (Decl) = Iir_Kind_Package_Declaration - and then Is_Uninstantiated_Package (Decl); - Mark : Id_Mark_Type; - Info : Ortho_Info_Acc; - Interface_List : O_Inter_List; - Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Interface_List : O_Inter_List; + begin + -- Declare elaborator for the spec. + Start_Procedure_Decl + (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage); + Subprgs.Add_Subprg_Instance_Interfaces + (Interface_List, Info.Package_Elab_Spec_Instance); + Finish_Subprogram_Decl + (Interface_List, Info.Package_Elab_Spec_Subprg); + + -- Declare elaborator for the body. + Start_Procedure_Decl + (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage); + Subprgs.Add_Subprg_Instance_Interfaces + (Interface_List, Info.Package_Elab_Body_Instance); + Finish_Subprogram_Decl + (Interface_List, Info.Package_Elab_Body_Subprg); + end Create_Package_Elaborator; + + -- Translate a non-uninstantiated package declaration. + -- HEADER is the node containing generic and generic_map. + procedure Translate_Package_Concrete_Common (Decl : Iir; Header : Iir) + is + Info : Ortho_Info_Acc; begin Info := Add_Info (Decl, Kind_Package); - if Is_Nested then - Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + if Header /= Null_Iir then + Chap4.Translate_Generic_Association_Chain (Header); end if; - -- Translate declarations. - if Is_Uninstantiated then - -- Create an instance for the spec. - Push_Instance_Factory (Info.Package_Spec_Scope'Access); - Chap4.Translate_Generic_Chain (Header); - Chap4.Translate_Declaration_Chain (Decl); + Chap4.Translate_Declaration_Chain (Decl); + + Save_Local_Identifier (Info.Package_Local_Id); + end Translate_Package_Concrete_Common; + + procedure Translate_Package_Concrete_Unit (Decl : Iir; Header : Iir) + is + Info : constant Ortho_Info_Acc := Get_Info (Decl); + begin + Info.Package_Elab_Var := Create_Var + (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type); + + -- For nested package, this will be translated when translating + -- subprograms. + Chap4.Translate_Declaration_Chain_Subprograms_Spec_Body (Decl); + + Create_Package_Elaborator (Info); + + if Flag_Rti then + -- Generate RTI. + Rtis.Generate_Unit (Decl); + end if; + + if Global_Storage /= O_Storage_External then + -- Create elaboration procedure for the spec + Elab_Package_Internal (Decl, Header); + end if; + + -- Overwrite the value written by Translate_Package_Concrete_Common. + Save_Local_Identifier (Info.Package_Local_Id); + end Translate_Package_Concrete_Unit; + + -- Translate a package declaration or a macro-expanded package + -- instantiation. HEADER is the node containing generic and generic_map. + procedure Translate_Package_Uninst_Common (Decl : Iir; Header : Iir) + is + Add_Body : constant Boolean := + not Get_Need_Body (Decl) and then Get_Package_Body (Decl) = Null_Iir; + Info : Ortho_Info_Acc; + begin + Info := Add_Info (Decl, Kind_Package); + + -- Create an instance for the spec. + Push_Instance_Factory (Info.Package_Spec_Scope'Access); + Chap4.Translate_Generic_Chain (Header); + Chap4.Translate_Declaration_Chain (Decl); + if not Is_Nested_Package (Decl) then Info.Package_Elab_Var := Create_Var (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type); - Pop_Instance_Factory (Info.Package_Spec_Scope'Access); + end if; + Pop_Instance_Factory (Info.Package_Spec_Scope'Access); + + -- Name the spec instance and create a pointer. + New_Type_Decl (Create_Identifier ("SPECINSTTYPE"), + Get_Scope_Type (Info.Package_Spec_Scope)); + Declare_Scope_Acc (Info.Package_Spec_Scope, + Create_Identifier ("SPECINSTPTR"), + Info.Package_Spec_Ptr_Type); + + -- Create an instance and its pointer for the body. + Chap2.Declare_Inst_Type_And_Ptr + (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type); + + if Add_Body then + -- Generic package without a body. + -- Create an empty body instance. + Push_Package_Instance_Factory (Decl); + Pop_Package_Instance_Factory (Decl); + end if; + Save_Local_Identifier (Info.Package_Local_Id); + end Translate_Package_Uninst_Common; + + procedure Translate_Package_Uninst_Unit (Decl : Iir; Header : Iir) + is + Info : constant Ortho_Info_Acc := Get_Info (Decl); + Add_Body : constant Boolean := + not Get_Need_Body (Decl) and then Get_Package_Body (Decl) = Null_Iir; + Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + begin + -- Each subprogram has a body instance argument (because subprograms + -- body can access body declarations). + Subprgs.Push_Subprg_Instance + (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type, + Wki_Instance, Prev_Subprg_Instance); + + -- For nested package, this will be translated when translating + -- subprograms. + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Only_Spec); + + Create_Package_Elaborator (Info); + + Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + + if Flag_Rti then + -- Generate RTI. + Rtis.Generate_Unit (Decl); + end if; + + if Add_Body and then Global_Storage /= O_Storage_External then + -- For nested package, this will be translated when translating + -- subprograms. + Set_Scope_Via_Field (Info.Package_Spec_Scope, + Info.Package_Spec_Field, + Info.Package_Body_Scope'Access); + + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Only_Body); - -- Name the spec instance and create a pointer. - New_Type_Decl (Create_Identifier ("SPECINSTTYPE"), - Get_Scope_Type (Info.Package_Spec_Scope)); - Declare_Scope_Acc (Info.Package_Spec_Scope, - Create_Identifier ("SPECINSTPTR"), - Info.Package_Spec_Ptr_Type); + -- Create elaboration procedure for the spec + Elab_Package_Internal (Decl, Header); - -- Create an instance and its pointer for the body. - Chap2.Declare_Inst_Type_And_Ptr - (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type); + Clear_Scope (Info.Package_Spec_Scope); + end if; + + Save_Local_Identifier (Info.Package_Local_Id); + end Translate_Package_Uninst_Unit; - -- Each subprogram has a body instance argument (because subprogram - -- bodys can access to body declarations). + procedure Translate_Package_Declaration_Subprograms + (Decl : Iir_Package_Declaration; What : Subprg_Translate_Kind) + is + Info : constant Ortho_Info_Acc := Get_Info (Decl); + Is_Uninst : constant Boolean := Is_Uninstantiated_Package (Decl); + Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Mark : Id_Mark_Type; + begin + if Is_Uninst and then Get_Macro_Expanded_Flag (Decl) then + -- Nothing to do for macro-expanded packages. + return; + end if; + + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + + if Is_Uninst then + -- An extra parameter for the package instance needs to be added + -- to the subprograms. Subprgs.Push_Subprg_Instance (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type, Wki_Instance, Prev_Subprg_Instance); + end if; - if not Is_Nested then - -- For nested package, this will be translated when translating - -- subprograms. - Chap4.Translate_Declaration_Chain_Subprograms - (Decl, Subprg_Translate_Only_Spec); - end if; - else - if Header /= Null_Iir then - Chap4.Translate_Generic_Association_Chain (Header); - end if; - Chap4.Translate_Declaration_Chain (Decl); - if not Is_Nested then - Info.Package_Elab_Var := Create_Var - (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type); + Chap4.Translate_Declaration_Chain_Subprograms (Decl, What); + + if Is_Uninst then + if What in Subprg_Translate_Spec then + -- Also declare elaborator subprograms. + Create_Package_Elaborator (Info); end if; - -- Translate subprograms declarations. - if not Is_Nested then + Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + + if What in Subprg_Translate_Body then -- For nested package, this will be translated when translating -- subprograms. - Chap4.Translate_Declaration_Chain_Subprograms - (Decl, Subprg_Translate_Spec_And_Body); - end if; - end if; + Set_Scope_Via_Field (Info.Package_Spec_Scope, + Info.Package_Spec_Field, + Info.Package_Body_Scope'Access); - if not Is_Nested then - -- Declare elaborator for the spec. - Start_Procedure_Decl - (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage); - Subprgs.Add_Subprg_Instance_Interfaces - (Interface_List, Info.Package_Elab_Spec_Instance); - Finish_Subprogram_Decl - (Interface_List, Info.Package_Elab_Spec_Subprg); + Elab_Package_Internal (Decl, Get_Package_Header (Decl)); - -- Declare elaborator for the body. - Start_Procedure_Decl - (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage); - Subprgs.Add_Subprg_Instance_Interfaces - (Interface_List, Info.Package_Elab_Body_Instance); - Finish_Subprogram_Decl - (Interface_List, Info.Package_Elab_Body_Subprg); + Clear_Scope (Info.Package_Spec_Scope); - if Flag_Rti then - -- Generate RTI. - Rtis.Generate_Unit (Decl); + if not Get_Need_Body (Decl) + and then Get_Package_Body (Decl) = Null_Iir + then + Elab_Package_Body (Decl, Null_Iir); + end if; end if; end if; - if Is_Uninstantiated then - if not Get_Need_Body (Decl) - and then Get_Package_Body (Decl) = Null_Iir - then - -- Generic package without a body. - -- Create an empty body instance. - Push_Package_Instance_Factory (Decl); - Pop_Package_Instance_Factory (Decl); + Pop_Identifier_Prefix (Mark); + end Translate_Package_Declaration_Subprograms; - if not Is_Nested - and then Global_Storage /= O_Storage_External - then - -- For nested package, this will be translated when translating - -- subprograms. - Set_Scope_Via_Field (Info.Package_Spec_Scope, - Info.Package_Spec_Field, - Info.Package_Body_Scope'Access); + procedure Translate_Package_Body_Subprograms + (Bod : Iir_Package_Body; What : Subprg_Translate_Kind) + is + Spec : constant Iir := Get_Package (Bod); + Is_Uninst : constant Boolean := Is_Uninstantiated_Package (Spec); + Info : constant Ortho_Info_Acc := Get_Info (Spec); + Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Mark : Id_Mark_Type; + begin + if Is_Uninst and then Get_Macro_Expanded_Flag (Spec) then + -- Nothing to do for macro-expanded packages. + return; + end if; - Chap4.Translate_Declaration_Chain_Subprograms - (Decl, Subprg_Translate_Only_Body); + Push_Identifier_Prefix (Mark, Get_Identifier (Spec)); - -- Create elaboration procedure for the spec - Elab_Package (Decl, Header); + if Is_Uninst then + -- An extra parameter for the package instance needs to be added + -- to the subprograms. + Subprgs.Push_Subprg_Instance + (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type, + Wki_Instance, Prev_Subprg_Instance); - Clear_Scope (Info.Package_Spec_Scope); - end if; - end if; + -- For nested package, this will be translated when translating + -- subprograms. + Set_Scope_Via_Field (Info.Package_Spec_Scope, + Info.Package_Spec_Field, + Info.Package_Body_Scope'Access); + end if; + Chap4.Translate_Declaration_Chain_Subprograms (Bod, What); + + if Is_Uninst then + Clear_Scope (Info.Package_Spec_Scope); Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); - else - if not Is_Nested - and then Global_Storage /= O_Storage_External - then - -- Create elaboration procedure for the spec - Elab_Package (Decl, Header); + + if What in Subprg_Translate_Body then + Elab_Package_Body (Spec, Bod); end if; end if; - Save_Local_Identifier (Info.Package_Local_Id); - if Is_Nested then - Pop_Identifier_Prefix (Mark); - end if; - end Translate_Package; + Pop_Identifier_Prefix (Mark); + end Translate_Package_Body_Subprograms; - procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration) is + procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration) + is + Mark : Id_Mark_Type; begin -- Skip uninstantiated package that have to be macro-expanded. if Get_Macro_Expanded_Flag (Decl) then return; end if; - Translate_Package (Decl, Get_Package_Header (Decl)); + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + + if Is_Uninstantiated_Package (Decl) then + Translate_Package_Uninst_Common (Decl, Get_Package_Header (Decl)); + else + Translate_Package_Concrete_Common (Decl, Get_Package_Header (Decl)); + end if; + + Pop_Identifier_Prefix (Mark); end Translate_Package_Declaration; - procedure Translate_Package_Body (Bod : Iir_Package_Body) + procedure Translate_Package_Declaration_Unit + (Decl : Iir_Package_Declaration) + is + Header : Iir; + begin + -- Skip uninstantiated package that have to be macro-expanded. + if Get_Macro_Expanded_Flag (Decl) then + return; + end if; + + Header := Get_Package_Header (Decl); + if Is_Uninstantiated_Package (Decl) then + Translate_Package_Uninst_Common (Decl, Header); + Translate_Package_Uninst_Unit (Decl, Header); + else + Translate_Package_Concrete_Common (Decl, Header); + Translate_Package_Concrete_Unit (Decl, Header); + end if; + end Translate_Package_Declaration_Unit; + + procedure Translate_Package_Body_Internal (Bod : Iir_Package_Body) is Is_Nested : constant Boolean := Is_Nested_Package (Bod); Spec : constant Iir_Package_Declaration := Get_Package (Bod); @@ -923,16 +1068,11 @@ package body Trans.Chap2 is Info : constant Ortho_Info_Acc := Get_Info (Spec); Prev_Storage : constant O_Storage := Global_Storage; Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; - Mark : Id_Mark_Type; begin if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then return; end if; - if Is_Nested then - Push_Identifier_Prefix (Mark, Get_Identifier (Spec)); - end if; - -- Translate declarations. if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then Push_Package_Instance_Factory (Spec); @@ -949,9 +1089,6 @@ package body Trans.Chap2 is -- May be called during elaboration to generate RTI. if Global_Storage = O_Storage_External then - if Is_Nested then - Pop_Identifier_Prefix (Mark); - end if; return; end if; @@ -985,26 +1122,47 @@ package body Trans.Chap2 is if not Is_Nested then Chap4.Translate_Declaration_Chain_Subprograms (Spec, Subprg_Translate_Only_Body); - Elab_Package (Spec, Get_Package_Header (Spec)); + Elab_Package_Internal (Spec, Get_Package_Header (Spec)); end if; Clear_Scope (Info.Package_Spec_Scope); end if; - if not Is_Nested then + if not Is_Nested and Flag_Elaboration then Elab_Package_Body (Spec, Bod); end if; Global_Storage := Prev_Storage; + end Translate_Package_Body_Internal; - if Is_Nested then - Pop_Identifier_Prefix (Mark); - end if; + -- For a nested package body or for a nested package instantiation body. + procedure Translate_Package_Body (Bod : Iir_Package_Body) + is + Spec : constant Iir_Package_Declaration := Get_Package (Bod); + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Spec)); + + Translate_Package_Body_Internal (Bod); + + Pop_Identifier_Prefix (Mark); end Translate_Package_Body; + procedure Translate_Package_Body_Unit (Bod : Iir_Package_Body) is + begin + if not Flag_Elaboration then + return; + end if; + + Translate_Package_Body_Internal (Bod); + end Translate_Package_Body_Unit; + -- Elaborate a package or a package instantiation. - procedure Elab_Package (Spec : Iir; Header : Iir) + procedure Elab_Package_Internal (Spec : Iir; Header : Iir) is Is_Nested : constant Boolean := Is_Nested_Package (Spec); + Is_Uninst : constant Boolean := + Get_Kind (Spec) = Iir_Kind_Package_Declaration + and then Is_Uninstantiated_Package (Spec); Info : constant Ortho_Info_Acc := Get_Info (Spec); Final : Boolean; Constr : O_Assoc_List; @@ -1013,16 +1171,16 @@ package body Trans.Chap2 is return; end if; - if not Is_Nested then + if (not Is_Nested) or else Is_Uninst then Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg); Push_Local_Factory; Subprgs.Start_Subprg_Instance_Use (Info.Package_Elab_Spec_Instance); - Elab_Dependence (Get_Design_Unit (Spec)); + if not Is_Nested then + Elab_Dependence (Get_Design_Unit (Spec)); + end if; - if not (Get_Kind (Spec) = Iir_Kind_Package_Declaration - and then Is_Uninstantiated_Package (Spec)) - then + if not Is_Uninst then -- Register the top level package. This is done dynamically, as -- we know only during elaboration that the design depends on a -- package (a package maybe referenced by an entity which is never @@ -1046,34 +1204,43 @@ package body Trans.Chap2 is Chap4.Elab_Declaration_Chain (Spec, Final); pragma Unreferenced (Final); - if not Is_Nested and then Flag_Elaboration then + if (not Is_Nested) or else Is_Uninst then Close_Temp; Subprgs.Finish_Subprg_Instance_Use (Info.Package_Elab_Spec_Instance); Pop_Local_Factory; Finish_Subprogram_Body; end if; - end Elab_Package; + end Elab_Package_Internal; + + procedure Elab_Package_Declaration (Spec : Iir) is + begin + Elab_Package_Internal (Spec, Get_Package_Header (Spec)); + end Elab_Package_Declaration; procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir) is + -- SPEC can be a package declaration or a package instantiation. Is_Spec_Decl : constant Boolean := Get_Kind (Spec) = Iir_Kind_Package_Declaration; + Is_Uninst : constant Boolean := + Is_Spec_Decl and then Is_Uninstantiated_Package (Spec); Info : constant Ortho_Info_Acc := Get_Info (Spec); If_Blk : O_If_Block; Constr : O_Assoc_List; Final : Boolean; begin - if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then - return; - end if; + -- Macro-expanded packages are skipped. + pragma Assert + (not (Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec))); - if not Flag_Elaboration and not Is_Nested_Package (Spec) then - return; - end if; + -- No elaboration code generated, except for nested packages + -- (could be within a subprogram). + pragma Assert (Flag_Elaboration or else Is_Nested_Package (Spec)); - if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then + if Is_Uninst then + -- Make spec reachable. Set_Scope_Via_Field (Info.Package_Spec_Scope, Info.Package_Spec_Field, Info.Package_Body_Scope'Access); @@ -1085,12 +1252,14 @@ package body Trans.Chap2 is -- If the package was already elaborated, return now, -- else mark the package as elaborated. - Start_If_Stmt (If_Blk, New_Value (Get_Var (Info.Package_Elab_Var))); - New_Return_Stmt; - New_Else_Stmt (If_Blk); - New_Assign_Stmt (Get_Var (Info.Package_Elab_Var), - New_Lit (Ghdl_Bool_True_Node)); - Finish_If_Stmt (If_Blk); + if Info.Package_Elab_Var /= Null_Var then + Start_If_Stmt (If_Blk, New_Value (Get_Var (Info.Package_Elab_Var))); + New_Return_Stmt; + New_Else_Stmt (If_Blk); + New_Assign_Stmt (Get_Var (Info.Package_Elab_Var), + New_Lit (Ghdl_Bool_True_Node)); + Finish_If_Stmt (If_Blk); + end if; -- Elab Spec. Start_Association (Constr, Info.Package_Elab_Spec_Subprg); @@ -1098,7 +1267,10 @@ package body Trans.Chap2 is New_Procedure_Call (Constr); if Bod /= Null_Iir then - Elab_Dependence (Get_Design_Unit (Bod)); + if not Is_Nested_Package (Bod) then + Elab_Dependence (Get_Design_Unit (Bod)); + end if; + Open_Temp; Chap4.Elab_Declaration_Chain (Bod, Final); Close_Temp; @@ -1108,11 +1280,20 @@ package body Trans.Chap2 is Pop_Local_Factory; Finish_Subprogram_Body; - if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then + if Is_Uninst then Clear_Scope (Info.Package_Spec_Scope); end if; end Elab_Package_Body; + procedure Elab_Package_Unit_Without_Body (Spec : Iir) is + begin + if Get_Macro_Expanded_Flag (Spec) then + return; + end if; + + Elab_Package_Body (Spec, Null_Iir); + end Elab_Package_Unit_Without_Body; + procedure Instantiate_Iir_Info (N : Iir); procedure Instantiate_Iir_Chain_Info (Chain : Iir) @@ -1599,35 +1780,57 @@ package body Trans.Chap2 is (Info.Package_Instance_Spec_Scope'Access); end Instantiate_Info_Package; - procedure Translate_Package_Instantiation_Declaration (Inst : Iir) + procedure Update_Info_Package (Inst : Iir) is - Spec : constant Iir := Get_Uninstantiated_Package_Decl (Inst); - Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec); - Info : Ortho_Info_Acc; - Interface_List : O_Inter_List; + Spec : constant Iir := Get_Uninstantiated_Package_Decl (Inst); + Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec); + Info : constant Ortho_Info_Acc := Get_Info (Inst); + El : Iir; begin - if Get_Macro_Expanded_Flag (Spec) then - -- Macro-expanded instantiations are translated like a package. - Translate_Package (Inst, Inst); + -- Create the info instances. + Push_Instantiate_Var_Scope + (Info.Package_Instance_Spec_Scope'Access, + Pkg_Info.Package_Spec_Scope'Access); + Push_Instantiate_Var_Scope + (Info.Package_Instance_Body_Scope'Access, + Pkg_Info.Package_Body_Scope'Access); - -- Generate code for the body. - declare - Bod : constant Iir := Get_Instance_Package_Body (Inst); - begin - if Get_Immediate_Body_Flag (Inst) then - Translate_Package_Body (Bod); - elsif not Get_Need_Body (Spec) - and then not Is_Nested_Package (Inst) - and then Global_Storage /= O_Storage_External - then - -- As an elaboration subprogram for the body is always - -- needed, generate it. - Elab_Package_Body (Inst, Null_Iir); - end if; - end; - return; - end if; + El := Get_Declaration_Chain (Inst); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + declare + Orig : constant Iir := + Vhdl.Sem_Inst.Get_Origin (El); + pragma Assert (Orig /= Null_Iir); + Orig_Info : constant Ortho_Info_Acc := + Get_Info (Orig); + Info : constant Ortho_Info_Acc := Get_Info (El); + begin + if Orig_Info /= null then + Copy_Info (Info, Orig_Info); + Clean_Copy_Info (Info); + end if; + end; + when others => + null; + end case; + El := Get_Chain (El); + end loop; + Pop_Instantiate_Var_Scope + (Info.Package_Instance_Body_Scope'Access); + Pop_Instantiate_Var_Scope + (Info.Package_Instance_Spec_Scope'Access); + end Update_Info_Package; + + procedure Translate_Package_Instantiation_Declaration_Internal (Inst : Iir) + is + Spec : constant Iir := Get_Uninstantiated_Package_Decl (Inst); + Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec); + Info : Ortho_Info_Acc; + begin Info := Add_Info (Inst, Kind_Package_Instance); -- Create the variable containing data for the package instance. @@ -1644,36 +1847,113 @@ package body Trans.Chap2 is Info.Package_Instance_Body_Scope'Access); Instantiate_Info_Package (Inst); + end Translate_Package_Instantiation_Declaration_Internal; - if Is_Nested_Package (Inst) or else not Flag_Elaboration then - return; + procedure Translate_Package_Instantiation_Declaration_Macro (Inst : Iir) is + begin + -- Generate code for the body. + if Get_Immediate_Body_Flag (Inst) then + Translate_Package_Body_Internal (Get_Instance_Package_Body (Inst)); + elsif not Get_Need_Body (Get_Uninstantiated_Package_Decl (Inst)) + and then not Is_Nested_Package (Inst) + and then Global_Storage /= O_Storage_External + then + -- As an elaboration subprogram for the body is always + -- needed, generate it. + Elab_Package_Body (Inst, Null_Iir); end if; + end Translate_Package_Instantiation_Declaration_Macro; - -- Declare elaboration procedure - Start_Procedure_Decl - (Interface_List, Create_Identifier ("ELAB"), Global_Storage); - -- Chap2.Add_Subprg_Instance_Interfaces - -- (Interface_List, Info.Package_Instance_Elab_Instance); - Finish_Subprogram_Decl - (Interface_List, Info.Package_Instance_Elab_Subprg); + procedure Translate_Package_Instantiation_Declaration (Inst : Iir) + is + Spec : constant Iir := Get_Uninstantiated_Package_Decl (Inst); + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Inst)); - if Global_Storage = O_Storage_External then - return; + if Get_Macro_Expanded_Flag (Spec) then + Translate_Package_Concrete_Common (Inst, Inst); + Translate_Package_Instantiation_Declaration_Macro (Inst); + else + Translate_Package_Instantiation_Declaration_Internal (Inst); end if; - -- Elaborator: - Start_Subprogram_Body (Info.Package_Instance_Elab_Subprg); - -- Chap2.Start_Subprg_Instance_Use - -- (Info.Package_Instance_Elab_Instance); + Pop_Identifier_Prefix (Mark); + end Translate_Package_Instantiation_Declaration; - Elab_Dependence (Get_Design_Unit (Inst)); + procedure Translate_Package_Instantiation_Declaration_Subprograms + (Inst : Iir; What : Subprg_Translate_Kind) is + begin + if Get_Macro_Expanded_Flag (Get_Uninstantiated_Package_Decl (Inst)) then + declare + Bod : constant Iir := Get_Instance_Package_Body (Inst); + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Inst)); + Chap4.Translate_Declaration_Chain_Subprograms (Inst, What); + if Is_Valid (Bod) + and then Global_Storage /= O_Storage_External + and then Get_Immediate_Body_Flag (Inst) + then + Chap4.Translate_Declaration_Chain_Subprograms (Bod, What); + end if; + Pop_Identifier_Prefix (Mark); + end; + else + if What in Subprg_Translate_Spec then + -- Update info for subprgs. + -- Info have been instantiated but may not be complete as the + -- ortho node may be created later. + Update_Info_Package (Inst); + end if; + end if; + end Translate_Package_Instantiation_Declaration_Subprograms; - Elab_Package_Instantiation_Declaration (Inst); + procedure Translate_Package_Instantiation_Declaration_Unit (Inst : Iir) + is + Spec : constant Iir := Get_Uninstantiated_Package_Decl (Inst); + Interface_List : O_Inter_List; + Info : Ortho_Info_Acc; + begin + if Get_Macro_Expanded_Flag (Spec) then + Translate_Package_Concrete_Common (Inst, Inst); + Translate_Package_Concrete_Unit (Inst, Inst); + Translate_Package_Instantiation_Declaration_Macro (Inst); + else + Translate_Package_Instantiation_Declaration_Internal (Inst); - -- Chap2.Finish_Subprg_Instance_Use - -- (Info.Package_Instance_Elab_Instance); - Finish_Subprogram_Body; - end Translate_Package_Instantiation_Declaration; + if not Flag_Elaboration then + return; + end if; + + Info := Get_Info (Inst); + + -- Declare elaboration procedure + Start_Procedure_Decl + (Interface_List, Create_Identifier ("ELAB"), Global_Storage); + -- Chap2.Add_Subprg_Instance_Interfaces + -- (Interface_List, Info.Package_Instance_Elab_Instance); + Finish_Subprogram_Decl + (Interface_List, Info.Package_Instance_Elab_Subprg); + + if Global_Storage = O_Storage_External then + return; + end if; + + -- Elaborator: + Start_Subprogram_Body (Info.Package_Instance_Elab_Subprg); + -- Chap2.Start_Subprg_Instance_Use + -- (Info.Package_Instance_Elab_Instance); + + Elab_Dependence (Get_Design_Unit (Inst)); + + Elab_Package_Instantiation_Declaration (Inst); + + -- Chap2.Finish_Subprg_Instance_Use + -- (Info.Package_Instance_Elab_Instance); + Finish_Subprogram_Body; + end if; + end Translate_Package_Instantiation_Declaration_Unit; procedure Elab_Package_Instantiation_Declaration (Inst : Iir) is @@ -1685,19 +1965,18 @@ package body Trans.Chap2 is -- Macro-expanded instances are handled like a regular package. if Get_Macro_Expanded_Flag (Spec) then declare - Spec_Parent : constant Iir := Get_Parent (Spec); Bod : constant Iir := Get_Package_Body (Spec); begin -- There are no routines generated to elaborate macro-expanded -- packages, but dependencies still need to be elaborated. - if Get_Kind (Spec_Parent) = Iir_Kind_Design_Unit then + if not Is_Nested_Package (Spec) then Elab_Dependence (Get_Design_Unit (Spec)); if Bod /= Null_Iir then Elab_Dependence (Get_Design_Unit (Bod)); end if; end if; - Elab_Package (Inst, Inst); + Elab_Package_Internal (Inst, Inst); if Get_Immediate_Body_Flag (Inst) then -- Humm, if BOD is present then INST_BOD should also be diff --git a/src/vhdl/translate/trans-chap2.ads b/src/vhdl/translate/trans-chap2.ads index a3c6189d9..155b91487 100644 --- a/src/vhdl/translate/trans-chap2.ads +++ b/src/vhdl/translate/trans-chap2.ads @@ -29,13 +29,25 @@ package Trans.Chap2 is -- overload number if any. procedure Push_Subprg_Identifier (Spec : Iir; Mark : out Id_Mark_Type); + -- Package declaration, body and instantiation when they are design units. + procedure Translate_Package_Declaration_Unit + (Decl : Iir_Package_Declaration); + procedure Translate_Package_Body_Unit (Bod : Iir_Package_Body); + procedure Translate_Package_Instantiation_Declaration_Unit (Inst : Iir); + procedure Elab_Package_Unit_Without_Body (Spec : Iir); + + -- For nested packages. procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration); procedure Translate_Package_Body (Bod : Iir_Package_Body); procedure Translate_Package_Instantiation_Declaration (Inst : Iir); - - procedure Elab_Package (Spec : Iir; Header : Iir); + procedure Translate_Package_Declaration_Subprograms + (Decl : Iir_Package_Declaration; What : Subprg_Translate_Kind); + procedure Translate_Package_Body_Subprograms + (Bod : Iir_Package_Body; What : Subprg_Translate_Kind); + procedure Translate_Package_Instantiation_Declaration_Subprograms + (Inst : Iir; What : Subprg_Translate_Kind); + procedure Elab_Package_Declaration (Spec : Iir); procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir); - procedure Elab_Package_Instantiation_Declaration (Inst : Iir); -- Add info for an interface_package_declaration or a diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 07e3f9030..2c33231c4 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2598,22 +2598,18 @@ package body Trans.Chap4 is Create_Union_Scope (State_Scope.all, Scope_Type); end Translate_Statements_Chain_State_Declaration; - -- PKG is a nested package declaration or package body - -- Translate only if non-generic or non-macro expanded. - -- SPEC is the corresponding package declaration. - procedure Translate_Declaration_Chain_Subprograms_Package - (Pkg : Iir; Spec : Iir; What : Subprg_Translate_Kind) + procedure Translate_Declaration_Chain_Subprograms_Spec_Body (Parent : Iir) is - Mark : Id_Mark_Type; + What : Subprg_Translate_Kind; begin - if Get_Package_Header (Spec) = Null_Iir - or else not Get_Macro_Expanded_Flag (Spec) - then - Push_Identifier_Prefix (Mark, Get_Identifier (Pkg)); - Translate_Declaration_Chain_Subprograms (Pkg, What); - Pop_Identifier_Prefix (Mark); + if Global_Storage /= O_Storage_External then + What := Subprg_Translate_Spec_And_Body; + else + -- No need and incorrect to generate bodies when external storage. + What := Subprg_Translate_Only_Spec; end if; - end Translate_Declaration_Chain_Subprograms_Package; + Translate_Declaration_Chain_Subprograms (Parent, What); + end Translate_Declaration_Chain_Subprograms_Spec_Body; procedure Translate_Declaration_Chain_Subprograms (Parent : Iir; What : Subprg_Translate_Kind) @@ -2622,9 +2618,9 @@ package body Trans.Chap4 is Do_Specs : constant Boolean := What in Subprg_Translate_Spec; -- True iff bodies must be translated. - Do_Bodies : constant Boolean := - (What in Subprg_Translate_Body - and then Global_Storage /= O_Storage_External); + Do_Bodies : constant Boolean := What in Subprg_Translate_Body; + pragma Assert + (not (Do_Bodies and then Global_Storage = O_Storage_External)); El : Iir; Infos : Chap7.Implicit_Subprogram_Infos; @@ -2697,29 +2693,12 @@ package body Trans.Chap4 is Chap3.Translate_Protected_Type_Body_Subprograms_Body (El); end if; when Iir_Kind_Package_Declaration => - Translate_Declaration_Chain_Subprograms_Package (El, El, What); + Chap2.Translate_Package_Declaration_Subprograms (El, What); when Iir_Kind_Package_Body => - Translate_Declaration_Chain_Subprograms_Package - (El, Get_Package (El), What); + Chap2.Translate_Package_Body_Subprograms (El, What); when Iir_Kind_Package_Instantiation_Declaration => - if Get_Macro_Expanded_Flag - (Get_Uninstantiated_Package_Decl (El)) - then - declare - Bod : constant Iir := Get_Instance_Package_Body (El); - Mark : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - Translate_Declaration_Chain_Subprograms (El, What); - if Is_Valid (Bod) - and then Global_Storage /= O_Storage_External - and then Get_Immediate_Body_Flag (El) - then - Translate_Declaration_Chain_Subprograms (Bod, What); - end if; - Pop_Identifier_Prefix (Mark); - end; - end if; + Chap2.Translate_Package_Instantiation_Declaration_Subprograms + (El, What); when Iir_Kind_Package_Instantiation_Body => declare Mark : Id_Mark_Type; @@ -2832,8 +2811,11 @@ package body Trans.Chap4 is null; when Iir_Kind_Package_Declaration => - Chap2.Elab_Package (Decl, Get_Package_Header (Decl)); - -- FIXME: finalizer + if not Is_Uninstantiated_Package (Decl) then + -- Elaborate nested package (unless it is uninstantiated). + Chap2.Elab_Package_Declaration (Decl); + -- FIXME: finalizer + end if; when Iir_Kind_Package_Body => declare Nested_Final : Boolean; diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads index 02ff9a70e..cf4a6624b 100644 --- a/src/vhdl/translate/trans-chap4.ads +++ b/src/vhdl/translate/trans-chap4.ads @@ -57,6 +57,8 @@ package Trans.Chap4 is procedure Translate_Declaration_Chain_Subprograms (Parent : Iir; What : Subprg_Translate_Kind); + procedure Translate_Declaration_Chain_Subprograms_Spec_Body (Parent : Iir); + -- Create subprograms for type/function conversion of signal -- associations. -- ENTITY is the entity instantiated, which can be either diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 76fa7a0b3..86a18e892 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -167,21 +167,15 @@ package body Translation is when Iir_Kind_Package_Declaration => New_Debug_Comment_Decl ("package declaration " & Image_Identifier (Lib_Unit)); - Chap2.Translate_Package_Declaration (Lib_Unit); - if Get_Package_Origin (Lib_Unit) /= Null_Iir - and then Get_Package_Body (Lib_Unit) /= Null_Iir - then - -- Corresponding body for package instantiation. - Chap2.Translate_Package_Body (Get_Package_Body (Lib_Unit)); - end if; + Chap2.Translate_Package_Declaration_Unit (Lib_Unit); when Iir_Kind_Package_Body => New_Debug_Comment_Decl ("package body " & Image_Identifier (Lib_Unit)); - Chap2.Translate_Package_Body (Lib_Unit); + Chap2.Translate_Package_Body_Unit (Lib_Unit); when Iir_Kind_Package_Instantiation_Declaration => New_Debug_Comment_Decl ("package instantiation " & Image_Identifier (Lib_Unit)); - Chap2.Translate_Package_Instantiation_Declaration (Lib_Unit); + Chap2.Translate_Package_Instantiation_Declaration_Unit (Lib_Unit); when Iir_Kind_Entity_Declaration => New_Debug_Comment_Decl ("entity " & Image_Identifier (Lib_Unit)); Chap1.Translate_Entity_Declaration (Lib_Unit); diff --git a/src/vhdl/vhdl-ieee-std_logic_arith.adb b/src/vhdl/vhdl-ieee-std_logic_arith.adb index 0786f753e..b3f6e9c81 100644 --- a/src/vhdl/vhdl-ieee-std_logic_arith.adb +++ b/src/vhdl/vhdl-ieee-std_logic_arith.adb @@ -50,6 +50,12 @@ package body Vhdl.Ieee.Std_Logic_Arith is Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Int, Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Log); + Conv_Sgn_Patterns : constant Conv_Pattern_Type := + (Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Sgn, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Uns, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Int, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Log); + Conv_Int_Patterns : constant Conv_Pattern_Type := (Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Sgn, Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Uns, @@ -521,6 +527,8 @@ package body Vhdl.Ieee.Std_Logic_Arith is Def := Handle_Bin (Mul_Patterns); when Name_Conv_Unsigned => Def := Handle_Conv (Conv_Uns_Patterns); + when Name_Conv_Signed => + Def := Handle_Conv (Conv_Sgn_Patterns); when Name_Conv_Std_Logic_Vector => Def := Handle_Conv (Conv_Vec_Patterns); when Name_Op_Less => diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 3d9561662..95676af3e 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -6289,6 +6289,11 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Sgn, Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Log, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Int, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Uns, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Sgn, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Signed_Log, + Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Int, Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Uns, Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Sgn, |