diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/translate/trans-chap1.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 12 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 102 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 68 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 10 |
8 files changed, 126 insertions, 81 deletions
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 68f4acd57..93534f028 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -163,7 +163,8 @@ package body Trans.Chap1 is if Global_Storage = O_Storage_External then -- Entity declaration subprograms. - Chap4.Translate_Declaration_Chain_Subprograms (Entity); + Chap4.Translate_Declaration_Chain_Subprograms + (Entity, Subprg_Translate_Spec_And_Body); else -- Entity declaration and process subprograms. Chap9.Translate_Block_Subprograms (Entity, Entity); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 83bc97b31..df3298347 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -528,7 +528,8 @@ package body Trans.Chap2 is Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field (Prev_Subprg_Instances, Upframe_Field); - Chap4.Translate_Declaration_Chain_Subprograms (Subprg); + Chap4.Translate_Declaration_Chain_Subprograms + (Subprg, Subprg_Translate_Spec_And_Body); -- Link to previous frame Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field @@ -556,7 +557,8 @@ package body Trans.Chap2 is if not Has_Suspend and not Has_Nested then Chap4.Translate_Declaration_Chain (Subprg); Rtis.Generate_Subprogram_Body (Subprg); - Chap4.Translate_Declaration_Chain_Subprograms (Subprg); + Chap4.Translate_Declaration_Chain_Subprograms + (Subprg, Subprg_Translate_Spec_And_Body); else New_Var_Decl (Frame_Ptr, Get_Identifier ("FRAMEPTR"), O_Storage_Local, Frame_Ptr_Type); @@ -827,7 +829,8 @@ package body Trans.Chap2 is if not Is_Nested then -- For nested package, this will be translated when translating -- subprograms. - Chap4.Translate_Declaration_Chain_Subprograms (Decl); + Chap4.Translate_Declaration_Chain_Subprograms + (Decl, Subprg_Translate_Spec_And_Body); end if; -- Declare elaborator for the body. @@ -963,7 +966,8 @@ package body Trans.Chap2 is if not Is_Nested then -- Translate subprograms. For nested package, this has to be called -- when translating subprograms. - Chap4.Translate_Declaration_Chain_Subprograms (Bod); + Chap4.Translate_Declaration_Chain_Subprograms + (Bod, Subprg_Translate_Spec_And_Body); end if; if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index 0cfaecd71..39c170d2d 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -1543,7 +1543,7 @@ package body Trans.Chap3 is Pop_Identifier_Prefix (Mark); end Translate_Protected_Type; - procedure Translate_Protected_Type_Subprograms + procedure Translate_Protected_Type_Subprograms_Spec (Def : Iir_Protected_Type_Declaration) is Info : constant Type_Info_Acc := Get_Info (Def); @@ -1595,7 +1595,7 @@ package body Trans.Chap3 is Subprgs.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance); Pop_Identifier_Prefix (Mark); - end Translate_Protected_Type_Subprograms; + end Translate_Protected_Type_Subprograms_Spec; procedure Translate_Protected_Type_Body (Bod : Iir) is @@ -1618,7 +1618,6 @@ package body Trans.Chap3 is Chap4.Translate_Declaration_Chain (Bod); Pop_Instance_Factory (Info.B.Prot_Scope'Unrestricted_Access); - -- Info.Ortho_Type (Mode_Value) := Get_Scope_Type (Info.B.Prot_Scope); Pop_Identifier_Prefix (Mark); end Translate_Protected_Type_Body; @@ -1644,8 +1643,8 @@ package body Trans.Chap3 is Mark : Id_Mark_Type; Decl : constant Iir := Get_Protected_Type_Declaration (Bod); Info : constant Type_Info_Acc := Get_Info (Decl); - Final : Boolean; Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Final : Boolean; begin Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); @@ -1657,7 +1656,8 @@ package body Trans.Chap3 is Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field); - Chap4.Translate_Declaration_Chain_Subprograms (Bod); + 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); @@ -2349,29 +2349,33 @@ package body Trans.Chap3 is Create_Scalar_Type_Range_Type (Def, True); end Translate_Bool_Type_Definition; - procedure Translate_Type_Subprograms (Decl : Iir) + procedure Translate_Type_Subprograms + (Decl : Iir; Kind : Subprg_Translate_Kind) is - Def : Iir; + Def : constant Iir := Get_Type_Definition (Decl); Tinfo : Type_Info_Acc; Id : Name_Id; begin - Def := Get_Type_Definition (Decl); - - if Get_Kind (Def) in Iir_Kinds_Subtype_Definition then - -- Also elaborate the base type, iff DEF and its BASE_TYPE have - -- been declared by the same type declarator. This avoids several - -- elaboration of the same type. - Def := Get_Base_Type (Def); - - -- Consistency check. - pragma Assert (Get_Type_Declarator (Def) = Decl); - elsif Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then - return; - end if; - - if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then - Translate_Protected_Type_Subprograms (Def); - end if; + case Get_Kind (Def) is + when Iir_Kind_Incomplete_Type_Definition => + return; + when Iir_Kind_Protected_Type_Declaration => + Translate_Protected_Type_Subprograms_Spec (Def); + return; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition => + null; + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Access_Type_Definition => + -- Never complex. + return; + when others => + raise Internal_Error; + end case; Tinfo := Get_Info (Def); if not Is_Complex_Type (Tinfo) @@ -2380,32 +2384,36 @@ package body Trans.Chap3 is return; end if; - -- Declare subprograms. - Id := Get_Identifier (Decl); - Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value); - if Get_Has_Signal_Flag (Def) then - Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal); + if Kind in Subprg_Translate_Spec then + -- Declare subprograms. + Id := Get_Identifier (Decl); + Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value); + if Get_Has_Signal_Flag (Def) then + Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal); + end if; end if; - if Global_Storage = O_Storage_External then - return; - end if; + if Kind in Subprg_Translate_Body then + if Global_Storage = O_Storage_External then + return; + end if; - -- Define subprograms. - case Get_Kind (Def) is - when Iir_Kind_Array_Type_Definition => - Create_Array_Type_Builder (Def, Mode_Value); - if Get_Has_Signal_Flag (Def) then - Create_Array_Type_Builder (Def, Mode_Signal); - end if; - when Iir_Kind_Record_Type_Definition => - Create_Record_Type_Builder (Def, Mode_Value); - if Get_Has_Signal_Flag (Def) then - Create_Record_Type_Builder (Def, Mode_Signal); - end if; - when others => - Error_Kind ("translate_type_subprograms", Def); - end case; + -- Define subprograms. + case Get_Kind (Def) is + when Iir_Kind_Array_Type_Definition => + Create_Array_Type_Builder (Def, Mode_Value); + if Get_Has_Signal_Flag (Def) then + Create_Array_Type_Builder (Def, Mode_Signal); + end if; + when Iir_Kind_Record_Type_Definition => + Create_Record_Type_Builder (Def, Mode_Value); + if Get_Has_Signal_Flag (Def) then + Create_Record_Type_Builder (Def, Mode_Signal); + end if; + when others => + Error_Kind ("translate_type_subprograms", Def); + end case; + end if; end Translate_Type_Subprograms; -- Initialize the objects related to a type (type range and type diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index ec0921b01..70a6fa35d 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -44,7 +44,8 @@ package Trans.Chap3 is procedure Translate_Anonymous_Type_Definition (Def : Iir); -- Translate subprograms for types. - procedure Translate_Type_Subprograms (Decl : Iir); + procedure Translate_Type_Subprograms + (Decl : Iir; Kind : Subprg_Translate_Kind); procedure Create_Type_Definition_Type_Range (Def : Iir); function Create_Static_Composite_Subtype_Bounds (Def : Iir) return O_Cnode; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 7d20e51fe..97bef532e 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2321,7 +2321,8 @@ package body Trans.Chap4 is Create_Union_Scope (State_Scope.all, Scope_Type); end Translate_Statements_Chain_State_Declaration; - procedure Translate_Declaration_Chain_Subprograms (Parent : Iir) + procedure Translate_Declaration_Chain_Subprograms + (Parent : Iir; What : Subprg_Translate_Kind) is El : Iir; Infos : Chap7.Implicit_Subprogram_Infos; @@ -2341,51 +2342,68 @@ package body Trans.Chap4 is | Iir_Predefined_Record_Equality => -- Used implicitly in case statement or other -- predefined equality. - Chap7.Translate_Implicit_Subprogram_Spec - (El, Infos); - Chap7.Translate_Implicit_Subprogram_Body (El); + if What in Subprg_Translate_Spec then + Chap7.Translate_Implicit_Subprogram_Spec + (El, Infos); + end if; + if What in Subprg_Translate_Body then + Chap7.Translate_Implicit_Subprogram_Body (El); + end if; when others => null; end case; else - Chap7.Translate_Implicit_Subprogram_Spec (El, Infos); - Chap7.Translate_Implicit_Subprogram_Body (El); + if What in Subprg_Translate_Spec then + Chap7.Translate_Implicit_Subprogram_Spec + (El, Infos); + end if; + if What in Subprg_Translate_Body then + Chap7.Translate_Implicit_Subprogram_Body (El); + end if; end if; else -- Translate only if used. - if Get_Info (El) /= null then + if What in Subprg_Translate_Spec + 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 => - -- 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))) - then - Chap2.Translate_Subprogram_Body (El); - Translate_Resolution_Function_Body - (Get_Subprogram_Specification (El)); + | Iir_Kind_Procedure_Body => + if What in Subprg_Translate_Body 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))) + then + Chap2.Translate_Subprogram_Body (El); + Translate_Resolution_Function_Body + (Get_Subprogram_Specification (El)); + end if; end if; when Iir_Kind_Type_Declaration | Iir_Kind_Anonymous_Type_Declaration => - Chap3.Translate_Type_Subprograms (El); + Chap3.Translate_Type_Subprograms (El, What); Chap7.Init_Implicit_Subprogram_Infos (Infos); when Iir_Kind_Protected_Type_Body => - Chap3.Translate_Protected_Type_Body (El); - Chap3.Translate_Protected_Type_Body_Subprograms (El); + if What in Subprg_Translate_Spec then + Chap3.Translate_Protected_Type_Body (El); + end if; + if What in Subprg_Translate_Body then + Chap3.Translate_Protected_Type_Body_Subprograms (El); + end if; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => declare Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (El)); - Translate_Declaration_Chain_Subprograms (El); + Translate_Declaration_Chain_Subprograms (El, What); Pop_Identifier_Prefix (Mark); end; when Iir_Kind_Package_Instantiation_Declaration => @@ -2397,11 +2415,11 @@ package body Trans.Chap4 is Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (El)); - Translate_Declaration_Chain_Subprograms (El); + Translate_Declaration_Chain_Subprograms (El, What); if Is_Valid (Bod) and then Global_Storage /= O_Storage_External then - Translate_Declaration_Chain_Subprograms (Bod); + Translate_Declaration_Chain_Subprograms (Bod, What); end if; Pop_Identifier_Prefix (Mark); end; diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads index cfc1917fe..6ada12419 100644 --- a/src/vhdl/translate/trans-chap4.ads +++ b/src/vhdl/translate/trans-chap4.ads @@ -36,7 +36,8 @@ package Trans.Chap4 is (Stmts : Iir; State_Scope : Var_Scope_Acc); -- Translate subprograms in declaration chain of PARENT. - procedure Translate_Declaration_Chain_Subprograms (Parent : Iir); + procedure Translate_Declaration_Chain_Subprograms + (Parent : Iir; What : Subprg_Translate_Kind); -- Create subprograms for type/function conversion of signal -- associations. diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 1b8f55a43..bbad1754a 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -996,7 +996,8 @@ package body Trans.Chap9 is Stmt : Iir; Mark : Id_Mark_Type; begin - Chap4.Translate_Declaration_Chain_Subprograms (Block); + Chap4.Translate_Declaration_Chain_Subprograms + (Block, Subprg_Translate_Spec_And_Body); Stmt := Get_Concurrent_Statement_Chain (Block); while Stmt /= Null_Iir loop @@ -1008,7 +1009,8 @@ package body Trans.Chap9 is Chap9.Set_Direct_Drivers (Stmt); end if; - Chap4.Translate_Declaration_Chain_Subprograms (Stmt); + Chap4.Translate_Declaration_Chain_Subprograms + (Stmt, Subprg_Translate_Spec_And_Body); Translate_Process_Statement (Stmt, Base_Info); if Flag_Direct_Drivers then diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 80392c86e..598e662f4 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -171,6 +171,16 @@ package Trans is type Allocation_Kind is (Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System); + -- Sometimes useful to factorize code. Defines what has to be translated. + type Subprg_Translate_Kind is + (Subprg_Translate_Only_Spec, + Subprg_Translate_Spec_And_Body, + Subprg_Translate_Only_Body); + subtype Subprg_Translate_Spec is Subprg_Translate_Kind range + Subprg_Translate_Only_Spec .. Subprg_Translate_Spec_And_Body; + subtype Subprg_Translate_Body is Subprg_Translate_Kind range + Subprg_Translate_Spec_And_Body .. Subprg_Translate_Only_Body; + -- Return the value of field FIELD of lnode L that is contains -- a pointer to a record. -- This is equivalent to: |