From 9dbe65d4db54dd5d44e2d140fa008e3150b882de Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Fri, 16 Jun 2017 07:53:12 +0200
Subject: Allocate dynamic object in suspended procedures on stack2.
---
src/vhdl/translate/trans-chap2.adb | 4 +-
src/vhdl/translate/trans-chap4.adb | 7 +++
src/vhdl/translate/trans-chap8.adb | 4 +-
src/vhdl/translate/trans-helpers2.adb | 3 +-
src/vhdl/translate/trans.adb | 80 ++++++++++++++++++++++++++---------
src/vhdl/translate/trans.ads | 13 ++++--
6 files changed, 82 insertions(+), 29 deletions(-)
(limited to 'src')
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 3f62db739..7798c93a8 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_Instance_Factory (Info.Subprg_Frame_Scope'Access);
+ Push_Frame_Factory (Info.Subprg_Frame_Scope'Access);
Add_Subprg_Instance_Field (Upframe_Field, Upframe_Scope);
if Info.Subprg_Params_Ptr /= O_Tnode_Null then
@@ -510,7 +510,7 @@ package body Trans.Chap2 is
Add_Scope_Field (Wki_Locvars, Info.Subprg_Locvars_Scope);
end if;
- Pop_Instance_Factory (Info.Subprg_Frame_Scope'Access);
+ Pop_Frame_Factory (Info.Subprg_Frame_Scope'Access);
New_Type_Decl (Create_Identifier ("_FRAMETYPE"),
Get_Scope_Type (Info.Subprg_Frame_Scope));
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index ff3c3870c..676f13613 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -582,6 +582,13 @@ package body Trans.Chap4 is
begin
Elab_Object_Storage (Obj);
Elab_Object_Init (Name, Obj, Value, Alloc_Kind);
+
+ if Alloc_Kind = Alloc_Return then
+ -- If the object is allocated on the return stack, avoid
+ -- deallocation. Deallocation must be done manually (this concerns
+ -- procedures with suspension).
+ Disable_Stack2_Release;
+ end if;
end Elab_Object_Value;
-- Create code to elaborate OBJ.
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index c55f48de6..531007d8b 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -2120,7 +2120,7 @@ package body Trans.Chap8 is
Push_Instance_Factory (Info.Call_State_Scope'Access);
-- Variable for the frame.
- Info.Call_Frame_Var := Create_Var (Create_Var_Identifier ("FRAME"),
+ Info.Call_Params_Var := Create_Var (Create_Var_Identifier ("PARAMS"),
Get_Info (Imp).Subprg_Params_Type,
O_Storage_Local);
Info.Call_State_Mark := Create_Var (Create_Var_Identifier ("MARK"),
@@ -2581,7 +2581,7 @@ package body Trans.Chap8 is
-- Save Stack2 mark. Callee allocate its frame on stack2.
if Is_Suspendable then
-- The caller is suspendable.
- Params_Var := Call_Info.Call_Frame_Var;
+ Params_Var := Call_Info.Call_Params_Var;
Mark_Var := Call_Info.Call_State_Mark;
-- There might be temporary variables created before the
-- suspension, eg for range checks.
diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb
index 500753bb5..11ea54042 100644
--- a/src/vhdl/translate/trans-helpers2.adb
+++ b/src/vhdl/translate/trans-helpers2.adb
@@ -129,8 +129,7 @@ package body Trans.Helpers2 is
end Gen_Memcpy;
function Gen_Alloc
- (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode)
- return O_Enode
+ (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode) return O_Enode
is
Constr : O_Assoc_List;
begin
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index 6c8bc048e..4689150cc 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -241,6 +241,20 @@ package body Trans is
New_Type_Decl (Name, Ptr_Type);
end Declare_Scope_Acc;
+ -- Common routine for instance and frame.
+ procedure Start_Instance_Factory (Inst : Inst_Build_Acc) is
+ begin
+ Identifier_Start := Identifier_Len + 1;
+
+ if Inst.Scope.Scope_Type /= O_Tnode_Null then
+ Start_Uncomplete_Record_Type
+ (Inst.Scope.Scope_Type, Inst.Elements);
+ else
+ Start_Record_Type (Inst.Elements);
+ end if;
+ Inst_Build := Inst;
+ end Start_Instance_Factory;
+
procedure Push_Instance_Factory (Scope : Var_Scope_Acc)
is
Inst : Inst_Build_Acc;
@@ -250,16 +264,21 @@ package body Trans is
Inst.Prev_Id_Start := Identifier_Start;
Inst.Scope := Scope;
- Identifier_Start := Identifier_Len + 1;
-
- if Scope.Scope_Type /= O_Tnode_Null then
- Start_Uncomplete_Record_Type (Scope.Scope_Type, Inst.Elements);
- else
- Start_Record_Type (Inst.Elements);
- end if;
- Inst_Build := Inst;
+ Start_Instance_Factory (Inst);
end Push_Instance_Factory;
+ procedure Push_Frame_Factory (Scope : Var_Scope_Acc)
+ is
+ Inst : Inst_Build_Acc;
+ begin
+ Inst := new Inst_Build_Type (Frame);
+ Inst.Prev := Inst_Build;
+ Inst.Prev_Id_Start := Identifier_Start;
+ Inst.Scope := Scope;
+
+ Start_Instance_Factory (Inst);
+ end Push_Frame_Factory;
+
function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
return O_Fnode
is
@@ -285,19 +304,31 @@ package body Trans is
Child.Field, Otype);
end Get_Scope_Offset;
- procedure Pop_Instance_Factory (Scope : in Var_Scope_Acc)
+ procedure Finish_Instance_Factory (Scope : in Var_Scope_Acc)
is
Res : O_Tnode;
begin
- if Inst_Build.Kind /= Instance then
- -- Not matching.
- raise Internal_Error;
- end if;
Finish_Record_Type (Inst_Build.Elements, Res);
Pop_Build_Instance;
Scope.Scope_Type := Res;
+ end Finish_Instance_Factory;
+
+ procedure Pop_Instance_Factory (Scope : in Var_Scope_Acc) is
+ begin
+ -- Not matching.
+ pragma Assert (Inst_Build.Kind = Instance);
+
+ Finish_Instance_Factory (Scope);
end Pop_Instance_Factory;
+ procedure Pop_Frame_Factory (Scope : in Var_Scope_Acc) is
+ begin
+ -- Not matching.
+ pragma Assert (Inst_Build.Kind = Frame);
+
+ Finish_Instance_Factory (Scope);
+ end Pop_Frame_Factory;
+
procedure Push_Local_Factory
is
Inst : Inst_Build_Acc;
@@ -335,7 +366,8 @@ package body Trans is
end if;
case Inst_Build.Kind is
when Local
- | Instance =>
+ | Instance
+ | Frame =>
return True;
when Global =>
return False;
@@ -496,11 +528,11 @@ 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 =>
+ when Instance | Frame =>
-- Create a field.
New_Record_Field (Inst_Build.Elements, Field, Name.Id, Vtype);
- return Var_Type'(Kind => Var_Scope, I_Field => Field,
- I_Scope => Inst_Build.Scope);
+ return Var_Type'(Kind => Var_Scope, I_Build_Kind => K,
+ I_Field => Field, I_Scope => Inst_Build.Scope);
end case;
end Create_Var;
@@ -592,9 +624,17 @@ package body Trans is
case Var.Kind is
when Var_Local =>
return Alloc_Stack;
- when Var_Global
- | Var_Scope =>
+ when Var_Global =>
return Alloc_System;
+ when Var_Scope =>
+ case Var.I_Build_Kind is
+ when Frame =>
+ return Alloc_Return;
+ when Instance =>
+ return Alloc_System;
+ when others =>
+ raise Internal_Error;
+ end case;
when Var_None =>
raise Internal_Error;
end case;
@@ -1052,6 +1092,7 @@ package body Trans is
when Var_Scope =>
return Var_Type'
(Kind => Var_Scope,
+ I_Build_Kind => Var.I_Build_Kind,
I_Field => Var.I_Field,
I_Scope => Instantiated_Var_Scope (Var.I_Scope));
end case;
@@ -1906,7 +1947,6 @@ package body Trans is
procedure Disable_Stack2_Release is
begin
- pragma Assert (not Temp_Level.No_Stack2_Mark);
Temp_Level.No_Stack2_Mark := True;
end Disable_Stack2_Release;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index cc74d46b5..1d57e7ed0 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -259,6 +259,9 @@ package Trans is
-- record type, that will be completed.
procedure Push_Instance_Factory (Scope : Var_Scope_Acc);
+ -- Likewise but for a frame.
+ procedure Push_Frame_Factory (Scope : Var_Scope_Acc);
+
-- Manually add a field to the current instance being built.
function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
return O_Fnode;
@@ -276,6 +279,7 @@ package Trans is
-- Finish the building of the current instance and return the type
-- built.
procedure Pop_Instance_Factory (Scope : Var_Scope_Acc);
+ procedure Pop_Frame_Factory (Scope : Var_Scope_Acc);
-- Create a new scope, in which variable are created locally
-- (ie, on the stack). Always created unlocked.
@@ -473,7 +477,7 @@ 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, Instance);
+ type Inst_Build_Kind_Type is (Local, Global, Frame, 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
@@ -485,7 +489,7 @@ package Trans is
Prev_Global_Storage : O_Storage;
when Global =>
null;
- when Instance =>
+ when Instance | Frame =>
Scope : Var_Scope_Acc;
Elements : O_Element_List;
end case;
@@ -506,6 +510,9 @@ package Trans is
| Var_Local =>
E : O_Dnode;
when Var_Scope =>
+ -- To remember allocator for this variable.
+ I_Build_Kind : Inst_Build_Kind_Type;
+
I_Field : O_Fnode;
I_Scope : Var_Scope_Acc;
end case;
@@ -1300,7 +1307,7 @@ package Trans is
when Kind_Call =>
Call_State_Scope : aliased Var_Scope_Type;
Call_State_Mark : Var_Type := Null_Var;
- Call_Frame_Var : Var_Type := Null_Var;
+ Call_Params_Var : Var_Type := Null_Var;
when Kind_Call_Assoc =>
-- Variable containing a reference to the actual, for scalar
--
cgit v1.2.3