diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 7 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-helpers2.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.adb | 80 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 13 |
6 files changed, 82 insertions, 29 deletions
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 |