diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/simulate/simul-elaboration.adb | 10 | ||||
| -rw-r--r-- | src/vhdl/simulate/simul-environments.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/simulate/simul-execution.adb | 77 | ||||
| -rw-r--r-- | src/vhdl/simulate/simul-execution.ads | 6 |
4 files changed, 60 insertions, 36 deletions
diff --git a/src/vhdl/simulate/simul-elaboration.adb b/src/vhdl/simulate/simul-elaboration.adb index e9b4a7b64..2163c80ff 100644 --- a/src/vhdl/simulate/simul-elaboration.adb +++ b/src/vhdl/simulate/simul-elaboration.adb @@ -349,6 +349,7 @@ package body Simul.Elaboration is Uninst_Scope => null, Up_Block => Father, Label => Stmt, + Bod => Null_Iir, Stmt => Obj, Parent => Father, Children => null, @@ -590,14 +591,18 @@ package body Simul.Elaboration is function Create_Protected_Object (Block: Block_Instance_Acc; Decl: Iir) return Iir_Value_Literal_Acc is - Bod : constant Iir := Get_Protected_Type_Body (Decl); + Bod : constant Iir := Execution.Get_Protected_Type_Body_Origin (Decl); + Bod_Info : constant Sim_Info_Acc := Get_Info (Bod); Inst : Block_Instance_Acc; Res : Iir_Value_Literal_Acc; begin Protected_Table.Increment_Last; Res := Create_Protected_Value (Protected_Table.Last); - Inst := Create_Subprogram_Instance (Block, null, Bod); + Inst := Create_Subprogram_Instance (Block, null, Decl); + if Bod_Info /= Get_Info (Decl) then + Inst.Uninst_Scope := Bod_Info; + end if; Protected_Table.Table (Res.Prot) := Inst; -- Temporary put the instancce on the stack in case of function calls @@ -2999,6 +3004,7 @@ package body Simul.Elaboration is Uninst_Scope => null, Up_Block => null, Label => Null_Iir, + Bod => Null_Iir, Stmt => Null_Iir, Parent => null, Children => null, diff --git a/src/vhdl/simulate/simul-environments.ads b/src/vhdl/simulate/simul-environments.ads index d5c20e104..d8c3885e6 100644 --- a/src/vhdl/simulate/simul-environments.ads +++ b/src/vhdl/simulate/simul-environments.ads @@ -313,6 +313,9 @@ package Simul.Environments is -- this instance. Label : Iir; + -- For subprograms: the body. + Bod : Iir; + -- For blocks: corresponding block (different from label for direct -- component instantiation statement and generate iterator). -- For packages: Null_Iir diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb index 47b79b369..edbfe8909 100644 --- a/src/vhdl/simulate/simul-execution.adb +++ b/src/vhdl/simulate/simul-execution.adb @@ -3325,58 +3325,71 @@ package body Simul.Execution is -- FIXME: maybe fix the issue directly in Sem_Inst ? function Get_Subprogram_Body_Origin (Spec : Iir) return Iir is - Orig : constant Iir := Sem_Inst.Get_Origin (Spec); + Res : constant Iir := Get_Subprogram_Body (Spec); + Orig : Iir; begin - if Orig /= Null_Iir then - return Get_Subprogram_Body_Origin (Orig); + if Res /= Null_Iir then + return Res; else - return Get_Subprogram_Body (Spec); + Orig := Sem_Inst.Get_Origin (Spec); + pragma Assert (Orig /= Null_Iir); + return Get_Subprogram_Body_Origin (Orig); end if; end Get_Subprogram_Body_Origin; + -- Like Get_Protected_Type_Body, but also works for instances, where + -- instantiated nodes have no bodies. + -- FIXME: maybe fix the issue directly in Sem_Inst ? + function Get_Protected_Type_Body_Origin (Spec : Iir) return Iir + is + Res : constant Iir := Get_Protected_Type_Body (Spec); + Orig : Iir; + begin + if Res /= Null_Iir then + return Res; + else + Orig := Sem_Inst.Get_Origin (Spec); + return Get_Protected_Type_Body_Origin (Orig); + end if; + end Get_Protected_Type_Body_Origin; + -- Create a block instance for subprogram IMP. function Create_Subprogram_Instance (Instance : Block_Instance_Acc; Prot_Obj : Block_Instance_Acc; Imp : Iir) return Block_Instance_Acc is - Parent : constant Iir := Get_Parent (Imp); + Parent : Iir; Bod : Iir; Up_Block: Block_Instance_Acc; Up_Info : Sim_Info_Acc; - Origin : Iir; Label : Iir; begin case Get_Kind (Imp) is when Iir_Kinds_Subprogram_Declaration => Bod := Get_Subprogram_Body_Origin (Imp); - when Iir_Kind_Protected_Type_Body => - Bod := Imp; + Parent := Get_Parent (Imp); + Label := Get_Subprogram_Specification (Bod); + when Iir_Kind_Protected_Type_Declaration => + -- The parent of the protected type body must have the same scope + -- as the parent of the protected type declaration. + Bod := Get_Protected_Type_Body_Origin (Imp); + Parent := Get_Parent (Get_Type_Declarator (Imp)); + Label := Imp; when others => Error_Kind ("create_subprogram_instance", Imp); end case; if Prot_Obj /= null then + -- This is a call to a method (from the outside to a subprogram of + -- a protected type). Put the protected object as upblock. Up_Block := Prot_Obj; - Label := Imp; else + -- This is a normal subprogram call. Up_Info := Get_Info_For_Scope (Parent); Up_Block := Get_Instance_By_Scope (Instance, Up_Info); - - if Up_Block.Uninst_Scope /= null then - Origin := Sem_Inst.Get_Origin (Imp); - pragma Assert (Origin /= Null_Iir); - -- Call to a subprogram of an instantiated package. - -- For a generic package, only the spec is instantiated, the body - -- is shared by all the instances. - - -- Execute code of the 'shared' body - Label := Origin; - else - Label := Imp; - end if; end if; -- Extract the info from the body, as it is complete (has slot for @@ -3402,7 +3415,8 @@ package body Simul.Execution is Block_Scope => Get_Info (Label), Uninst_Scope => null, Up_Block => Up_Block, - Label => Label, + Label => Imp, + Bod => Bod, Stmt => Null_Iir, Parent => Instance, Children => null, @@ -3433,27 +3447,24 @@ package body Simul.Execution is end Get_Protected_Object_Instance; -- Destroy a dynamic block_instance. - procedure Execute_Subprogram_Call_Final (Instance : Block_Instance_Acc) - is - Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label); + procedure Execute_Subprogram_Call_Final (Instance : Block_Instance_Acc) is begin Finalize_Declarative_Part - (Instance, Get_Declaration_Chain (Subprg_Body)); + (Instance, Get_Declaration_Chain (Instance.Bod)); end Execute_Subprogram_Call_Final; function Execute_Function_Body (Instance : Block_Instance_Acc) return Iir_Value_Literal_Acc is - Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label); Res : Iir_Value_Literal_Acc; begin Current_Process.Instance := Instance; Elaborate_Declarative_Part - (Instance, Get_Declaration_Chain (Subprg_Body)); + (Instance, Get_Declaration_Chain (Instance.Bod)); -- execute statements - Instance.Stmt := Get_Sequential_Statement_Chain (Subprg_Body); + Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Bod); Execute_Sequential_Statements (Current_Process); pragma Assert (Current_Process.Instance = Instance); @@ -4686,7 +4697,6 @@ package body Simul.Execution is 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 Execute_Implicit_Procedure (Instance, Call); @@ -4705,11 +4715,10 @@ package body Simul.Execution is (Instance, Subprg_Instance, Inter_Chain, Assoc_Chain); Current_Process.Instance := Subprg_Instance; - Subprg_Body := Get_Subprogram_Body (Imp); Elaborate_Declarative_Part - (Subprg_Instance, Get_Declaration_Chain (Subprg_Body)); + (Subprg_Instance, Get_Declaration_Chain (Subprg_Instance.Bod)); - Init_Sequential_Statements (Proc, Subprg_Body); + Init_Sequential_Statements (Proc, Subprg_Instance.Bod); end if; end Execute_Call_Statement; diff --git a/src/vhdl/simulate/simul-execution.ads b/src/vhdl/simulate/simul-execution.ads index 276f283e3..f85970048 100644 --- a/src/vhdl/simulate/simul-execution.ads +++ b/src/vhdl/simulate/simul-execution.ads @@ -208,4 +208,10 @@ package Simul.Execution is function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc; Expr_Type : Iir) return String; + + -- Like Get_Protected_Type_Body, but also works for instances, where + -- instantiated nodes have no bodies. + -- FIXME: maybe fix the issue directly in Sem_Inst ? + function Get_Protected_Type_Body_Origin (Spec : Iir) return Iir; + end Simul.Execution; |