diff options
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 123 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 37 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 37 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.adb | 15 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 9 |
6 files changed, 123 insertions, 101 deletions
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index df3298347..d24700f3e 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -426,6 +426,7 @@ package body Trans.Chap2 is Frame_Ptr_Type : O_Tnode; Upframe_Field : O_Fnode; + Upframe_Scope : Var_Scope_Acc; Frame : O_Dnode; Frame_Ptr : O_Dnode; @@ -457,7 +458,7 @@ package body Trans.Chap2 is -- Unnest subprograms. -- Create an instance for the local declarations. Push_Instance_Factory (Info.Subprg_Frame_Scope'Access); - Add_Subprg_Instance_Field (Upframe_Field); + Add_Subprg_Instance_Field (Upframe_Field, Upframe_Scope); if Info.Subprg_Params_Ptr /= O_Tnode_Null then -- Field for the parameters structure @@ -526,14 +527,14 @@ package body Trans.Chap2 is Wki_Upframe, Prev_Subprg_Instances); -- Link to previous frame Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field - (Prev_Subprg_Instances, Upframe_Field); + (Upframe_Scope, Upframe_Field); Chap4.Translate_Declaration_Chain_Subprograms (Subprg, Subprg_Translate_Spec_And_Body); -- Link to previous frame Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field - (Prev_Subprg_Instances, Upframe_Field); + (Upframe_Scope, Upframe_Field); -- Local frame Subprgs.Pop_Subprg_Instance (Wki_Upframe, Prev_Subprg_Instances); end if; @@ -796,24 +797,18 @@ package body Trans.Chap2 is Chap2.Declare_Inst_Type_And_Ptr (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type); - if not Get_Need_Body (Decl) - and then Get_Package_Body (Decl) = Null_Iir - then - -- Generic package without a body. - -- Create an empty body instance. - Push_Package_Instance_Factory (Decl); - Pop_Package_Instance_Factory (Decl); - - Set_Scope_Via_Field (Info.Package_Spec_Scope, - Info.Package_Spec_Field, - Info.Package_Body_Scope'Access); - end if; - -- Each subprogram has a body instance argument (because subprogram -- bodys can access to body declarations). Subprgs.Push_Subprg_Instance (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type, Wki_Instance, Prev_Subprg_Instance); + + if not Is_Nested then + -- For nested package, this will be translated when translating + -- subprograms. + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Only_Spec); + end if; else if Header /= Null_Iir then Chap4.Translate_Generic_Chain (Header); @@ -823,64 +818,74 @@ package body Trans.Chap2 is Info.Package_Elab_Var := Create_Var (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type); end if; - end if; - -- Translate subprograms declarations. - if not Is_Nested then - -- For nested package, this will be translated when translating - -- subprograms. - Chap4.Translate_Declaration_Chain_Subprograms - (Decl, Subprg_Translate_Spec_And_Body); + -- Translate subprograms declarations. + if not Is_Nested then + -- For nested package, this will be translated when translating + -- subprograms. + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Spec_And_Body); + end if; end if; - -- Declare elaborator for the body. if not Is_Nested then + -- Declare elaborator for the spec. + Start_Procedure_Decl + (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage); + Subprgs.Add_Subprg_Instance_Interfaces + (Interface_List, Info.Package_Elab_Spec_Instance); + Finish_Subprogram_Decl + (Interface_List, Info.Package_Elab_Spec_Subprg); + + -- Declare elaborator for the body. Start_Procedure_Decl (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage); Subprgs.Add_Subprg_Instance_Interfaces (Interface_List, Info.Package_Elab_Body_Instance); Finish_Subprogram_Decl (Interface_List, Info.Package_Elab_Body_Subprg); + + if Flag_Rti then + -- Generate RTI. + Rtis.Generate_Unit (Decl); + end if; end if; if Is_Uninstantiated then - Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); - if not Get_Need_Body (Decl) and then Get_Package_Body (Decl) = Null_Iir then - Clear_Scope (Info.Package_Spec_Scope); - end if; + -- Generic package without a body. + -- Create an empty body instance. + Push_Package_Instance_Factory (Decl); + Pop_Package_Instance_Factory (Decl); - -- The spec elaborator has a spec instance argument. - Subprgs.Push_Subprg_Instance - (Info.Package_Spec_Scope'Access, Info.Package_Spec_Ptr_Type, - Wki_Instance, Prev_Subprg_Instance); - end if; + Set_Scope_Via_Field (Info.Package_Spec_Scope, + Info.Package_Spec_Field, + Info.Package_Body_Scope'Access); - if not Is_Nested then - -- Declare elaborator for the spec. - Start_Procedure_Decl - (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage); - Subprgs.Add_Subprg_Instance_Interfaces - (Interface_List, Info.Package_Elab_Spec_Instance); - Finish_Subprogram_Decl - (Interface_List, Info.Package_Elab_Spec_Subprg); + if not Is_Nested + and then Global_Storage /= O_Storage_External + then + -- For nested package, this will be translated when translating + -- subprograms. + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Only_Body); - if Flag_Rti then - -- Generate RTI. - Rtis.Generate_Unit (Decl); + -- Create elaboration procedure for the spec + Elab_Package (Decl, Header); + end if; end if; - if Global_Storage /= O_Storage_External then + Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + else + if not Is_Nested + and then Global_Storage /= O_Storage_External + then -- Create elaboration procedure for the spec Elab_Package (Decl, Header); end if; end if; - - if Is_Uninstantiated then - Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); - end if; Save_Local_Identifier (Info.Package_Local_Id); if Is_Nested then @@ -971,8 +976,12 @@ package body Trans.Chap2 is end if; if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then - Clear_Scope (Info.Package_Spec_Scope); Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + if not Is_Nested then + Chap4.Translate_Declaration_Chain_Subprograms + (Spec, Subprg_Translate_Only_Body); + Elab_Package (Spec, Get_Package_Header (Spec)); + end if; end if; if not Is_Nested then @@ -1055,12 +1064,6 @@ package body Trans.Chap2 is Push_Local_Factory; Subprgs.Start_Subprg_Instance_Use (Info.Package_Elab_Body_Instance); - if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then - Set_Scope_Via_Field (Info.Package_Spec_Scope, - Info.Package_Spec_Field, - Info.Package_Body_Scope'Access); - end if; - -- If the package was already elaborated, return now, -- else mark the package as elaborated. Start_If_Stmt (If_Blk, New_Value (Get_Var (Info.Package_Elab_Var))); @@ -1082,10 +1085,6 @@ package body Trans.Chap2 is Close_Temp; end if; - if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then - Clear_Scope (Info.Package_Spec_Scope); - end if; - Subprgs.Finish_Subprg_Instance_Use (Info.Package_Elab_Body_Instance); Pop_Local_Factory; Finish_Subprogram_Body; @@ -1542,13 +1541,9 @@ package body Trans.Chap2 is Set_Scope_Via_Var (Pkg_Info.Package_Body_Scope, Info.Package_Instance_Body_Var); - Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope, - Pkg_Info.Package_Spec_Field, - Pkg_Info.Package_Body_Scope'Access); Chap5.Elab_Generic_Map_Aspect (Get_Package_Header (Spec), Inst, (Pkg_Info.Package_Body_Scope'Access, Pkg_Info.Package_Body_Scope)); - Clear_Scope (Pkg_Info.Package_Spec_Scope); -- Call the elaborator of the generic. The generic must be -- temporary associated with the instance variable. diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index 39c170d2d..ecc5906a8 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -1609,7 +1609,8 @@ package body Trans.Chap3 is -- Create the object type Push_Instance_Factory (Info.B.Prot_Scope'Unrestricted_Access); -- First, the previous instance. - Subprgs.Add_Subprg_Instance_Field (Info.B.Prot_Subprg_Instance_Field); + Subprgs.Add_Subprg_Instance_Field + (Info.B.Prot_Subprg_Instance_Field, Info.B.Prot_Prev_Scope); -- Then the object lock Info.B.Prot_Lock_Field := Add_Instance_Factory_Field (Get_Identifier ("LOCK"), Ghdl_Ptr_Type); @@ -1638,13 +1639,12 @@ package body Trans.Chap3 is New_Procedure_Call (Assoc); end Call_Ghdl_Protected_Procedure; - procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir) + procedure Translate_Protected_Type_Body_Subprograms_Spec (Bod : Iir) is Mark : Id_Mark_Type; Decl : constant Iir := Get_Protected_Type_Declaration (Bod); Info : constant Type_Info_Acc := Get_Info (Decl); Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; - Final : Boolean; begin Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); @@ -1653,23 +1653,32 @@ package body Trans.Chap3 is Info.Ortho_Ptr_Type (Mode_Value), Wki_Obj, Prev_Subprg_Instance); + + -- Environment is referenced through the object. Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field - (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field); + (Info.B.Prot_Prev_Scope, Info.B.Prot_Subprg_Instance_Field); Chap4.Translate_Declaration_Chain_Subprograms (Bod, Subprg_Translate_Spec_And_Body); - Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field - (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field); Subprgs.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance); + Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field + (Info.B.Prot_Prev_Scope, Info.B.Prot_Subprg_Instance_Field); + Pop_Identifier_Prefix (Mark); + end Translate_Protected_Type_Body_Subprograms_Spec; - if Global_Storage = O_Storage_External then - return; - end if; + procedure Translate_Protected_Type_Body_Subprograms_Body (Bod : Iir) + is + Decl : constant Iir := Get_Protected_Type_Declaration (Bod); + Info : constant Type_Info_Acc := Get_Info (Decl); + Final : Boolean; + begin + pragma Assert (Global_Storage /= O_Storage_External); -- Init subprogram + -- Contrary to other subprograms, no object is passed to it. declare Var_Obj : O_Dnode; begin @@ -1709,6 +1718,9 @@ package body Trans.Chap3 is Finish_Subprogram_Body; end; +-- Chap4.Translate_Declaration_Chain_Subprograms +-- (Bod, Subprg_Translate_Only_Body); + -- Fini subprogram begin Start_Subprogram_Body (Info.B.Prot_Final_Subprg); @@ -1725,7 +1737,8 @@ package body Trans.Chap3 is Subprgs.Finish_Subprg_Instance_Use (Info.B.Prot_Final_Instance); Finish_Subprogram_Body; end; - end Translate_Protected_Type_Body_Subprograms; + + end Translate_Protected_Type_Body_Subprograms_Body; --------------- -- Scalars -- @@ -2360,7 +2373,9 @@ package body Trans.Chap3 is when Iir_Kind_Incomplete_Type_Definition => return; when Iir_Kind_Protected_Type_Declaration => - Translate_Protected_Type_Subprograms_Spec (Def); + if Kind in Subprg_Translate_Spec then + Translate_Protected_Type_Subprograms_Spec (Def); + end if; return; when Iir_Kind_Record_Type_Definition | Iir_Kind_Array_Type_Definition => diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index 70a6fa35d..91c13e9ff 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -58,7 +58,8 @@ package Trans.Chap3 is procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode); procedure Translate_Protected_Type_Body (Bod : Iir); - procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir); + procedure Translate_Protected_Type_Body_Subprograms_Spec (Bod : Iir); + procedure Translate_Protected_Type_Body_Subprograms_Body (Bod : Iir); -- Translate_type_definition_Elab do 4 and 6. -- It generates code to do type elaboration. diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 97bef532e..88ab87206 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2324,6 +2324,14 @@ package body Trans.Chap4 is procedure Translate_Declaration_Chain_Subprograms (Parent : Iir; What : Subprg_Translate_Kind) is + -- True iff specs must be translated. + Do_Specs : constant Boolean := What in Subprg_Translate_Spec; + + -- True iff bodies must be translated. + Do_Bodies : constant Boolean := + (What in Subprg_Translate_Body + and then Global_Storage /= O_Storage_External); + El : Iir; Infos : Chap7.Implicit_Subprogram_Infos; begin @@ -2342,44 +2350,40 @@ package body Trans.Chap4 is | Iir_Predefined_Record_Equality => -- Used implicitly in case statement or other -- predefined equality. - if What in Subprg_Translate_Spec then + if Do_Specs then Chap7.Translate_Implicit_Subprogram_Spec (El, Infos); end if; - if What in Subprg_Translate_Body then + if Do_Bodies then Chap7.Translate_Implicit_Subprogram_Body (El); end if; when others => null; end case; else - if What in Subprg_Translate_Spec then + if Do_Specs then Chap7.Translate_Implicit_Subprogram_Spec (El, Infos); end if; - if What in Subprg_Translate_Body then + if Do_Bodies then Chap7.Translate_Implicit_Subprogram_Body (El); end if; end if; else -- Translate only if used. - if What in Subprg_Translate_Spec - and then Get_Info (El) /= null - then + if Do_Specs and then Get_Info (El) /= null then Chap2.Translate_Subprogram_Declaration (El); Translate_Resolution_Function (El); end if; end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => - if What in Subprg_Translate_Body then + if Do_Bodies then -- Do not translate body if generating only specs (for -- subprograms in an entity). - if Global_Storage /= O_Storage_External - and then - (not Flag_Discard_Unused - or else - Get_Use_Flag (Get_Subprogram_Specification (El))) + if not Flag_Discard_Unused + or else + Get_Use_Flag (Get_Subprogram_Specification (El)) then Chap2.Translate_Subprogram_Body (El); Translate_Resolution_Function_Body @@ -2391,11 +2395,12 @@ package body Trans.Chap4 is Chap3.Translate_Type_Subprograms (El, What); Chap7.Init_Implicit_Subprogram_Infos (Infos); when Iir_Kind_Protected_Type_Body => - if What in Subprg_Translate_Spec then + if Do_Specs then Chap3.Translate_Protected_Type_Body (El); end if; - if What in Subprg_Translate_Body then - Chap3.Translate_Protected_Type_Body_Subprograms (El); + if Do_Bodies then + Chap3.Translate_Protected_Type_Body_Subprograms_Spec (El); + Chap3.Translate_Protected_Type_Body_Subprograms_Body (El); end if; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index d41458d08..1f9d177a4 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -76,14 +76,17 @@ package body Trans is end if; end Add_Subprg_Instance_Interfaces; - procedure Add_Subprg_Instance_Field (Field : out O_Fnode) is + procedure Add_Subprg_Instance_Field + (Field : out O_Fnode; Prev_Scope : out Var_Scope_Acc) is begin if Has_Current_Subprg_Instance then Field := Add_Instance_Factory_Field (Current_Subprg_Instance.Ident, Current_Subprg_Instance.Ptr_Type); + Prev_Scope := Current_Subprg_Instance.Scope; else Field := O_Fnode_Null; + Prev_Scope := null; end if; end Add_Subprg_Instance_Field; @@ -113,7 +116,7 @@ package body Trans is (Var : O_Dnode; Field : O_Fnode; Vars : Subprg_Instance_Type) is begin - if Has_Subprg_Instance (Vars) then + if Has_Subprg_Instance (Vars) and then Field /= O_Fnode_Null then New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (Var), Field), New_Obj_Value (Vars.Inter)); end if; @@ -134,19 +137,19 @@ package body Trans is end Finish_Subprg_Instance_Use; procedure Start_Prev_Subprg_Instance_Use_Via_Field - (Prev : Subprg_Instance_Stack; Field : O_Fnode) is + (Prev_Scope : Var_Scope_Acc; Field : O_Fnode) is begin if Field /= O_Fnode_Null then - Set_Scope_Via_Field_Ptr (Prev.Scope.all, Field, + Set_Scope_Via_Field_Ptr (Prev_Scope.all, Field, Current_Subprg_Instance.Scope); end if; end Start_Prev_Subprg_Instance_Use_Via_Field; procedure Finish_Prev_Subprg_Instance_Use_Via_Field - (Prev : Subprg_Instance_Stack; Field : O_Fnode) is + (Prev_Scope : Var_Scope_Acc; Field : O_Fnode) is begin if Field /= O_Fnode_Null then - Clear_Scope (Prev.Scope.all); + Clear_Scope (Prev_Scope.all); end if; end Finish_Prev_Subprg_Instance_Use_Via_Field; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 598e662f4..a93f38198 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -602,7 +602,8 @@ package Trans is -- Add a field in the current factory that reference the current -- instance. - procedure Add_Subprg_Instance_Field (Field : out O_Fnode); + procedure Add_Subprg_Instance_Field + (Field : out O_Fnode; Prev_Scope : out Var_Scope_Acc); -- Associate values to the instance interface during invocation of a -- subprogram. @@ -628,9 +629,9 @@ package Trans is -- Call Push_Scope to reference instance from FIELD. procedure Start_Prev_Subprg_Instance_Use_Via_Field - (Prev : Subprg_Instance_Stack; Field : O_Fnode); + (Prev_Scope : Var_Scope_Acc; Field : O_Fnode); procedure Finish_Prev_Subprg_Instance_Use_Via_Field - (Prev : Subprg_Instance_Stack; Field : O_Fnode); + (Prev_Scope : Var_Scope_Acc; Field : O_Fnode); -- Same as above, but for IIR. procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List; @@ -754,6 +755,7 @@ package Trans is when Kind_Type_Protected => Prot_Scope : aliased Var_Scope_Type; + Prot_Prev_Scope : Var_Scope_Acc; -- Init procedure for the protected type. Prot_Init_Subprg : O_Dnode; @@ -851,6 +853,7 @@ package Trans is (Kind => Kind_Type_Protected, Rti_Max_Depth => 0, Prot_Scope => Null_Var_Scope, + Prot_Prev_Scope => null, Prot_Init_Subprg => O_Dnode_Null, Prot_Init_Instance => Subprgs.Null_Subprg_Instance, Prot_Final_Subprg => O_Dnode_Null, |