translate: fix bug wrt complex variable while unnesting subprograms.

3 files changed, 44 insertions, 14 deletions

diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 4260c6d1d..672aeb1f9 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -456,7 +456,7 @@ package body Trans.Chap2 is
       if Has_Nested or else Has_Suspend then
          --  Unnest subprograms.
          --  Create an instance for the local declarations.
-         Push_Frame_Factory (Info.Subprg_Frame_Scope'Access);
+         Push_Frame_Factory (Info.Subprg_Frame_Scope'Access, Has_Suspend);
          Add_Subprg_Instance_Field (Upframe_Field, Upframe_Scope);
 
          if Info.Subprg_Params_Ptr /= O_Tnode_Null then
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index e776aae22..b298ad583 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -244,6 +244,9 @@ package body Trans is
       --  Common routine for instance and frame.
       procedure Start_Instance_Factory (Inst : Inst_Build_Acc) is
       begin
+         Inst.Prev := Inst_Build;
+         Inst.Prev_Id_Start := Identifier_Start;
+
          Identifier_Start := Identifier_Len + 1;
 
          if Inst.Scope.Scope_Type /= O_Tnode_Null then
@@ -260,20 +263,21 @@ package body Trans is
          Inst : Inst_Build_Acc;
       begin
          Inst := new Inst_Build_Type (Instance);
-         Inst.Prev := Inst_Build;
-         Inst.Prev_Id_Start := Identifier_Start;
          Inst.Scope := Scope;
 
          Start_Instance_Factory (Inst);
       end Push_Instance_Factory;
 
-      procedure Push_Frame_Factory (Scope : Var_Scope_Acc)
+      procedure Push_Frame_Factory (Scope : Var_Scope_Acc;
+                                    Persistant : Boolean)
       is
          Inst : Inst_Build_Acc;
       begin
-         Inst := new Inst_Build_Type (Frame);
-         Inst.Prev := Inst_Build;
-         Inst.Prev_Id_Start := Identifier_Start;
+         if Persistant then
+            Inst := new Inst_Build_Type (Persistant_Frame);
+         else
+            Inst := new Inst_Build_Type (Stack_Frame);
+         end if;
          Inst.Scope := Scope;
 
          Start_Instance_Factory (Inst);
@@ -324,7 +328,7 @@ package body Trans is
       procedure Pop_Frame_Factory (Scope : in Var_Scope_Acc) is
       begin
          --  Not matching.
-         pragma Assert (Inst_Build.Kind = Frame);
+         pragma Assert (Inst_Build.Kind in Stack_Frame .. Persistant_Frame);
 
          Finish_Instance_Factory (Scope);
       end Pop_Frame_Factory;
@@ -367,7 +371,8 @@ package body Trans is
          case Inst_Build.Kind is
             when Local
               | Instance
-              | Frame =>
+              | Stack_Frame
+              | Persistant_Frame =>
                return True;
             when Global =>
                return False;
@@ -528,7 +533,7 @@ package body Trans is
                --  Create a var.
                New_Var_Decl (Res, Name.Id, O_Storage_Local, Vtype);
                return Var_Type'(Kind => Var_Local, E => Res);
-            when Instance | Frame =>
+            when Instance | Stack_Frame | Persistant_Frame =>
                --  Create a field.
                New_Record_Field (Inst_Build.Elements, Field, Name.Id, Vtype);
                return Var_Type'(Kind => Var_Scope, I_Build_Kind => K,
@@ -628,7 +633,9 @@ package body Trans is
                return Alloc_System;
             when Var_Scope =>
                case Var.I_Build_Kind is
-                  when Frame =>
+                  when Stack_Frame =>
+                     return Alloc_Stack;
+                  when Persistant_Frame =>
                      return Alloc_Return;
                   when Instance =>
                      return Alloc_System;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 2129739e2..29dd593dc 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -265,7 +265,8 @@ package Trans is
       procedure Push_Instance_Factory (Scope : Var_Scope_Acc);
 
       --  Likewise but for a frame.
-      procedure Push_Frame_Factory (Scope : Var_Scope_Acc);
+      procedure Push_Frame_Factory (Scope : Var_Scope_Acc;
+                                    Persistant : Boolean);
 
       --  Manually add a field to the current instance being built.
       function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
@@ -482,7 +483,29 @@ package Trans is
       --  are translated into functions.  The first argument of these functions
       --  is a pointer to the instance.
 
-      type Inst_Build_Kind_Type is (Local, Global, Frame, Instance);
+      type Inst_Build_Kind_Type is
+        (
+         --  Variables are declared locally.
+         Local,
+
+         --  Variables are global.
+         Global,
+
+         --  A record frame is created, whose lifetime is the lifetime of the
+         --  subprogram.  Variables become fields of the record frame, and
+         --  dynamic memory is allocated from the stack.
+         Stack_Frame,
+
+         --  A record frame is created, whose lifetime is longer than the
+         --  lifetime of the subprogram (for subprogram with suspension).
+         --  Variables become fields, and dynamic memory is allocated from the
+         --  secondary stack.
+         Persistant_Frame,
+
+         --  An instance record is created, which is never free.  Dynamic
+         --  memory is allocated from the heap.
+         Instance);
+
       type Inst_Build_Type (Kind : Inst_Build_Kind_Type);
       type Inst_Build_Acc is access Inst_Build_Type;
       type Inst_Build_Type (Kind : Inst_Build_Kind_Type) is record
@@ -494,7 +517,7 @@ package Trans is
                Prev_Global_Storage : O_Storage;
             when Global =>
                null;
-            when Instance | Frame =>
+            when Instance | Stack_Frame | Persistant_Frame =>
                Scope               : Var_Scope_Acc;
                Elements            : O_Element_List;
          end case;