From 185c172b00eb3b7c16370f468960a65975e0fdf0 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 11 Jan 2023 20:24:05 +0100
Subject: synth: fix handle of protected type bodies within instantiated
 packages.

---
 src/synth/synth-vhdl_decls.adb | 10 ++++++++--
 src/vhdl/vhdl-sem_inst.adb     | 19 ++++++++++++++++++-
 src/vhdl/vhdl-sem_inst.ads     |  4 ++++
 3 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index 593452083..19473775f 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -28,6 +28,7 @@ with Netlists.Gates;
 
 with Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Sem_Inst;
 with Vhdl.Std_Package;
 
 with Elab.Memtype;
@@ -399,7 +400,8 @@ package body Synth.Vhdl_Decls is
       use Elab.Memtype;
       Prev_Instance_Pool : constant Areapools.Areapool_Acc := Instance_Pool;
       Decl_Type : constant Node := Get_Type (Var);
-      Bod : constant Node := Get_Protected_Type_Body (Decl_Type);
+      Bod : constant Node :=
+        Vhdl.Sem_Inst.Get_Protected_Type_Body_Origin (Decl_Type);
       Obj_Inst : Synth_Instance_Acc;
       Obj_Hand : Protected_Index;
       Mem : Memory_Ptr;
@@ -408,7 +410,11 @@ package body Synth.Vhdl_Decls is
       Res : Valtyp;
       Last_Type : Node;
    begin
-      Parent := Get_Instance_By_Scope (Inst, Get_Parent_Scope (Bod));
+      --  Get instance scope.  Use the protected type definition as the
+      --  instance for the body is the same, but the body can be shared in
+      --  within an instantiated package.
+      Parent := Get_Instance_By_Scope (Inst, Get_Parent_Scope (Decl_Type));
+
       Obj_Inst := Make_Elab_Instance (Parent, Var, Bod, Null_Node);
       Obj_Hand := Elab.Vhdl_Prot.Create (Obj_Inst);
 
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index 3272628d1..57225e2ae 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -664,17 +664,20 @@ package body Vhdl.Sem_Inst is
 
                when Field_Suspend_State_Chain =>
                   if Kind = Iir_Kind_Suspend_State_Declaration then
+                     --  Clear the fields for suspend state variable.
                      Set_Suspend_State_Chain (Res, Null_Node);
                      Set_Suspend_State_Last (Res, Null_Node);
                   else
+                     --  Link for suspend state statement.
                      declare
                         Decl : constant Node := Get_Suspend_State_Decl (Res);
                         Last : constant Node := Get_Suspend_State_Last (Decl);
                      begin
-                        Set_Suspend_State_Chain (Res, Last);
                         Set_Suspend_State_Last (Decl, Res);
                         if Last = Null_Node then
                            Set_Suspend_State_Chain (Decl, Res);
+                        else
+                           Set_Suspend_State_Chain (Last, Res);
                         end if;
                      end;
                   end if;
@@ -1482,4 +1485,18 @@ package body Vhdl.Sem_Inst is
          return Get_Subprogram_Body_Origin (Orig);
       end if;
    end Get_Subprogram_Body_Origin;
+
+   function Get_Protected_Type_Body_Origin (Atype : Iir) return Iir
+   is
+      Res : constant Iir := Get_Protected_Type_Body (Atype);
+      Orig : Iir;
+   begin
+      if Res /= Null_Iir then
+         return Res;
+      else
+         Orig := Get_Origin (Atype);
+         pragma Assert (Orig /= Null_Iir);
+         return Get_Protected_Type_Body_Origin (Orig);
+      end if;
+   end Get_Protected_Type_Body_Origin;
 end Vhdl.Sem_Inst;
diff --git a/src/vhdl/vhdl-sem_inst.ads b/src/vhdl/vhdl-sem_inst.ads
index dea437837..f86c1a560 100644
--- a/src/vhdl/vhdl-sem_inst.ads
+++ b/src/vhdl/vhdl-sem_inst.ads
@@ -53,4 +53,8 @@ package Vhdl.Sem_Inst is
    --  instantiated nodes have no bodies.
    --  See comment about Get/Set_Subprogram_body in vhdl-nodes.
    function Get_Subprogram_Body_Origin (Spec : Iir) return Iir;
+
+   --  Likewise for protected type bodies.
+   --  ATYPE is the protected type definition.
+   function Get_Protected_Type_Body_Origin (Atype : Iir) return Iir;
 end Vhdl.Sem_Inst;
-- 
cgit v1.2.3