simul: Add subprogram body in frames.

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;