diff options
| -rw-r--r-- | Makefile.in | 3 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 42 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.ads | 1 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 38 | ||||
| -rw-r--r-- | src/vhdl/simulate/simulation-main.adb | 4 |
5 files changed, 58 insertions, 30 deletions
diff --git a/Makefile.in b/Makefile.in index 461ec0a58..f223b0600 100644 --- a/Makefile.in +++ b/Makefile.in @@ -271,7 +271,8 @@ GHDL_SIMUL_INCFLAGS=$(GHDL_COMMON_INCFLAGS) -aI$(srcdir)/src/ghdldrv -aI$(srcdir ghdl_simul$(EXEEXT): $(GRT_ADD_OBJS) $(GRT_SRC_DEPS) version.ads force $(GNATMAKE) $(GHDL_SIMUL_INCFLAGS) $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) -libs.vhdl.simul: ghdl_simul$(EXEEXT) vhdl.libs.all +libs.vhdl.simul: ghdl_simul$(EXEEXT) + $(MAKE) GHDL=$(PWD)/ghdl_simul$(EXEEXT) vhdl.libs.all ################ mhdlsim (library for the vhdl part) #################### diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index e96f92b3f..dc0006130 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -51,6 +51,7 @@ package body Elaboration is procedure Elaborate_Generic_Map_Aspect (Target_Instance : Block_Instance_Acc; Local_Instance : Block_Instance_Acc; + Generics : Iir; Map : Iir); -- CONF is the block_configuration for components of ARCH. @@ -381,7 +382,9 @@ package body Elaboration is if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Decl)); Elaborate_Generic_Map_Aspect - (Instance, Instance, Get_Generic_Map_Aspect_Chain (Decl)); + (Instance, Instance, + Get_Generic_Chain (Decl), + Get_Generic_Map_Aspect_Chain (Decl)); end if; -- Elaborate objects declarations. @@ -1066,9 +1069,11 @@ package body Elaboration is procedure Elaborate_Generic_Map_Aspect (Target_Instance : Block_Instance_Acc; Local_Instance : Block_Instance_Acc; + Generics : Iir; Map : Iir) is Assoc : Iir; + Gen : Iir; Inter : Iir_Interface_Constant_Declaration; Value : Iir; Val : Iir_Value_Literal_Acc; @@ -1082,13 +1087,14 @@ package body Elaboration is -- elaboration of each generic association element in the -- association list. Assoc := Map; + Gen := Generics; Mark (Marker, Expr_Pool); while Assoc /= Null_Iir loop -- Elaboration of a generic association element consists of the -- elaboration of the formal part and the evaluation of the actual -- part. -- FIXME: elaboration of the formal part. - Inter := Get_Association_Interface (Assoc); + Inter := Get_Association_Interface (Assoc, Gen); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => -- The generic association list contains an implicit @@ -1170,7 +1176,7 @@ package body Elaboration is <<Continue>> null; Release (Marker, Expr_Pool); - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Gen); end loop; end Elaborate_Generic_Map_Aspect; @@ -1216,6 +1222,7 @@ package body Elaboration is Formal_Instance => Formal_Instance, Actual => Local_Expr, Actual_Instance => Local_Instance, + Inter => Inter, Assoc => Assoc)); end Elab_Connect; @@ -1228,6 +1235,7 @@ package body Elaboration is Map : Iir) is Assoc : Iir; + Port : Iir; Inter : Iir_Interface_Signal_Declaration; Actual_Expr : Iir_Value_Literal_Acc; Init_Expr : Iir_Value_Literal_Acc; @@ -1254,11 +1262,12 @@ package body Elaboration is end if; Assoc := Map; + Port := Ports; while Assoc /= Null_Iir loop -- Elaboration of a port association list consists of the elaboration -- of each port association element in the association list whose -- actual is not the reserved word OPEN. - Inter := Get_Association_Interface (Assoc); + Inter := Get_Association_Interface (Assoc, Port); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => if Get_In_Conversion (Assoc) = Null_Iir @@ -1355,7 +1364,7 @@ package body Elaboration is when others => Error_Kind ("elaborate_port_map_aspect", Assoc); end case; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Port); end loop; end Elaborate_Port_Map_Aspect; @@ -1369,7 +1378,9 @@ package body Elaboration is begin Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Header)); Elaborate_Generic_Map_Aspect - (Instance, Instance, Get_Generic_Map_Aspect_Chain (Header)); + (Instance, Instance, + Get_Generic_Chain (Header), + Get_Generic_Map_Aspect_Chain (Header)); Elaborate_Port_Clause (Instance, Get_Port_Chain (Header)); Elaborate_Port_Map_Aspect (Instance, Instance, @@ -1583,7 +1594,9 @@ package body Elaboration is Current_Component := Frame; Elaborate_Generic_Clause (Frame, Get_Generic_Chain (Component)); Elaborate_Generic_Map_Aspect - (Frame, Instance, Get_Generic_Map_Aspect_Chain (Stmt)); + (Frame, Instance, + Get_Generic_Chain (Component), + Get_Generic_Map_Aspect_Chain (Stmt)); Elaborate_Port_Clause (Frame, Get_Port_Chain (Component)); Elaborate_Port_Map_Aspect (Frame, Instance, @@ -2699,7 +2712,8 @@ package body Elaboration is Current_Component := Parent_Instance; Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Entity)); - Elaborate_Generic_Map_Aspect (Instance, Parent_Instance, Generic_Map); + Elaborate_Generic_Map_Aspect (Instance, Parent_Instance, + Get_Generic_Chain (Entity), Generic_Map); Elaborate_Port_Clause (Instance, Get_Port_Chain (Entity)); Elaborate_Port_Map_Aspect (Instance, Parent_Instance, Get_Port_Chain (Entity), Port_Map); @@ -2816,15 +2830,17 @@ package body Elaboration is end loop; end Override_Generics; - procedure Check_No_Unconstrained (Map : Iir) + procedure Check_No_Unconstrained (Ports : Iir; Map : Iir) is Assoc : Iir; + Port : Iir; Formal : Iir; begin Assoc := Map; + Port := Ports; while Assoc /= Null_Iir loop if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc); + Formal := Get_Association_Interface (Assoc, Port); if Get_Default_Value (Formal) = Null_Iir and then not Is_Fully_Constrained_Type (Get_Type (Formal)) then @@ -2832,7 +2848,7 @@ package body Elaboration is (Formal, "top-level %n must have a value", +Formal); end if; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Port); end loop; end Check_No_Unconstrained; @@ -2889,8 +2905,8 @@ package body Elaboration is (Get_Port_Chain (Entity), Null_Iir, Entity); Override_Generics (Generic_Map, Grt.Options.First_Generic_Override); - Check_No_Unconstrained (Generic_Map); - Check_No_Unconstrained (Port_Map); + Check_No_Unconstrained (Get_Generic_Chain (Entity), Generic_Map); + Check_No_Unconstrained (Get_Port_Chain (Entity), Port_Map); -- Stop now in case of errors. if Nbr_Errors /= 0 then diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads index f9a956128..f6dac20d5 100644 --- a/src/vhdl/simulate/elaboration.ads +++ b/src/vhdl/simulate/elaboration.ads @@ -173,6 +173,7 @@ package Elaboration is Formal_Instance : Block_Instance_Acc; Actual : Iir_Value_Literal_Acc; Actual_Instance : Block_Instance_Acc; + Inter : Iir; Assoc : Iir; end record; diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 41b7b2690..44bd4f9f5 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -2767,7 +2767,7 @@ package body Execution is if Unit = Null_Iir then Error_Msg_Exec ("incorrect unit name", Expr); end if; - Mult := Ghdl_I64 (Get_Value (Get_Physical_Unit_Value (Unit))); + Mult := Ghdl_I64 (Get_Value (Get_Physical_Unit (Unit))); Str_Bnd.Dim_1.Length := Lit_End; if Is_Real then @@ -3458,12 +3458,14 @@ package body Execution is -- Establish correspondance for association list ASSOC_LIST from block -- instance OUT_BLOCK for subprogram of block SUBPRG_BLOCK. procedure Execute_Association - (Out_Block: Block_Instance_Acc; - Subprg_Block: Block_Instance_Acc; - Assoc_Chain: Iir) + (Out_Block : Block_Instance_Acc; + Subprg_Block : Block_Instance_Acc; + Inter_Chain : Iir; + Assoc_Chain : Iir) is Nbr_Assoc : constant Natural := Get_Chain_Length (Assoc_Chain); Assoc: Iir; + Assoc_Inter : Iir; Actual : Iir; Inter: Iir; Formal : Iir; @@ -3478,10 +3480,11 @@ package body Execution is Mark (Marker, Expr_Pool); Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; Assoc_Idx := 1; while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); - Inter := Get_Association_Interface (Assoc); + Inter := Get_Association_Interface (Assoc, Assoc_Inter); -- Extract the actual value. case Get_Kind (Assoc) is @@ -3614,7 +3617,7 @@ package body Execution is end if; << Continue >> null; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Assoc_Inter); Assoc_Idx := Assoc_Idx + 1; end loop; @@ -3623,18 +3626,21 @@ package body Execution is procedure Execute_Back_Association (Instance : Block_Instance_Acc) is - Proc : constant Iir := Get_Procedure_Call (Instance.Parent.Stmt); - Assoc: Iir; - Inter: Iir; + Call : constant Iir := Get_Procedure_Call (Instance.Parent.Stmt); + Imp : constant Iir := Get_Implementation (Call); + Assoc : Iir; + Assoc_Inter : Iir; + Inter : Iir; Formal : Iir; Assoc_Idx : Iir_Index32; begin - Assoc := Get_Parameter_Association_Chain (Proc); + Assoc := Get_Parameter_Association_Chain (Call); + Assoc_Inter := Get_Interface_Declaration_Chain (Imp); Assoc_Idx := 1; while Assoc /= Null_Iir loop if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then Formal := Get_Formal (Assoc); - Inter := Get_Association_Interface (Assoc); + Inter := Get_Association_Interface (Assoc, Assoc_Inter); case Get_Kind (Inter) is when Iir_Kind_Interface_Variable_Declaration => if Get_Mode (Inter) /= Iir_In_Mode @@ -3678,7 +3684,7 @@ package body Execution is Error_Kind ("execute_back_association", Inter); end case; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Assoc_Inter); Assoc_Idx := Assoc_Idx + 1; end loop; end Execute_Back_Association; @@ -3733,7 +3739,8 @@ package body Execution is Subprg_Block := Create_Subprogram_Instance (Block, Prot_Block, Imp); Assoc_Chain := Get_Parameter_Association_Chain (Expr); - Execute_Association (Block, Subprg_Block, Assoc_Chain); + Execute_Association + (Block, Subprg_Block, Inter_Chain, Assoc_Chain); -- No out/inout interface for functions. pragma Assert (Subprg_Block.Actuals_Ref = null); when Iir_Kinds_Dyadic_Operator => @@ -4531,6 +4538,7 @@ package body Execution is Subprg_Instance : Block_Instance_Acc; Prot_Block : Block_Instance_Acc; Assoc_Chain: Iir; + Inter_Chain : Iir; Subprg_Body : Iir; begin if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then @@ -4545,7 +4553,9 @@ package body Execution is Subprg_Instance := Create_Subprogram_Instance (Instance, Prot_Block, Imp); Assoc_Chain := Get_Parameter_Association_Chain (Call); - Execute_Association (Instance, Subprg_Instance, Assoc_Chain); + Inter_Chain := Get_Interface_Declaration_Chain (Imp); + Execute_Association + (Instance, Subprg_Instance, Inter_Chain, Assoc_Chain); Current_Process.Instance := Subprg_Instance; Subprg_Body := Get_Subprogram_Body (Imp); diff --git a/src/vhdl/simulate/simulation-main.adb b/src/vhdl/simulate/simulation-main.adb index 0faf6254c..1b7f1eb63 100644 --- a/src/vhdl/simulate/simulation-main.adb +++ b/src/vhdl/simulate/simulation-main.adb @@ -676,11 +676,11 @@ package body Simulation.Main is Formal_Expr : Iir_Value_Literal_Acc; Local_Instance : Block_Instance_Acc; Local_Expr : Iir_Value_Literal_Acc; + Inter : Iir; Assoc : Iir_Association_Element_By_Expression) is pragma Unreferenced (Formal_Instance); Formal : constant Iir := Get_Formal (Assoc); - Inter : constant Iir := Get_Association_Interface (Assoc); begin if False and Trace_Elaboration then Put ("connect formal "); @@ -767,7 +767,7 @@ package body Simulation.Main is begin Set_Connect (E.Formal_Instance, E.Formal, E.Actual_Instance, E.Actual, - E.Assoc); + E.Inter, E.Assoc); end; end loop; |