diff options
| -rw-r--r-- | canon.adb | 3 | ||||
| -rw-r--r-- | sem.adb | 1 | ||||
| -rw-r--r-- | sem.ads | 2 | ||||
| -rw-r--r-- | sem_names.adb | 3 | ||||
| -rw-r--r-- | translate/trans_be.adb | 3 | ||||
| -rw-r--r-- | translate/translation.adb | 49 |
6 files changed, 43 insertions, 18 deletions
@@ -190,7 +190,8 @@ package body Canon is when Iir_Kinds_Type_Attribute => null; - when Iir_Kind_Event_Attribute => + when Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute => -- LRM 8.1 -- An attribute name: [...]; otherwise, apply this rule to the -- prefix of the attribute name. @@ -2309,6 +2309,7 @@ package body Sem is return; end if; Libraries.Load_Design_Unit (Prefix_Name, Clause); + Add_Dependence (Prefix_Name); when others => Error_Msg_Sem ("prefix must designate a package or a library", Prefix); @@ -30,7 +30,7 @@ package Sem is function Get_Current_Design_Unit return Iir_Design_Unit; -- Makes the current design unit depends on UNIT. - -- UNIT must be either an entit_aspect or a design_unit. + -- UNIT must be either an entity_aspect or a design_unit. procedure Add_Dependence (Unit : Iir); -- Add EL in the current design unit list of items to be checked later. diff --git a/sem_names.adb b/sem_names.adb index f7a28a5..f56dabc 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1229,6 +1229,9 @@ package body Sem_Names is case Get_Kind (Res) is when Iir_Kind_Design_Unit => return; + when Iir_Kind_Block_Statement => + -- Part of an expanded name + return; when Iir_Kinds_Object_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Type_Declaration diff --git a/translate/trans_be.adb b/translate/trans_be.adb index 0725fb7..80b4689 100644 --- a/translate/trans_be.adb +++ b/translate/trans_be.adb @@ -118,9 +118,6 @@ package body Trans_Be is if not Main then -- Main units (those from the analyzed design file) are translated -- directly by ortho_front. - if Flags.Verbose then - Put_Line ("translate " & Disp_Node (Lib)); - end if; Translation.Translate (Unit, Main); diff --git a/translate/translation.adb b/translate/translation.adb index 8acbc7b..7ed526c 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -3978,8 +3978,11 @@ package body Translation is Rtis.Generate_Unit (Entity); end if; - if Global_Storage /= O_Storage_External then - -- Entity process subprograms. + if Global_Storage = O_Storage_External then + -- Entity declaration subprograms. + Chap4.Translate_Declaration_Chain_Subprograms (Entity, Entity); + else + -- Entity declaration and process subprograms. Chap9.Translate_Block_Subprograms (Entity, Entity); -- Elaborator Body. @@ -10321,7 +10324,9 @@ package body Translation is -- check for matching bounds. Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind); when Type_Mode_Array - | Type_Mode_Ptr_Array => + | Type_Mode_Ptr_Array + | Type_Mode_Acc + | Type_Mode_Fat_Acc => -- Create an object pointer. -- At elaboration: copy base from name. Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind); @@ -10386,6 +10391,10 @@ package body Translation is Name_Type, Name_Node, Decl); Close_Temp; + when Type_Mode_Acc + | Type_Mode_Fat_Acc => + New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), + M2Addr (Name_Node)); when Type_Mode_Scalar => case Alias_Info.Alias_Kind is when Mode_Value => @@ -10965,8 +10974,13 @@ package body Translation is end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => - if not Flag_Discard_Unused - or else Get_Use_Flag (Get_Subprogram_Specification (El)) + -- 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 @@ -13258,7 +13272,10 @@ package body Translation is return Get_Var (Name_Info.Alias_Var, Type_Info, Name_Info.Alias_Kind); when Type_Mode_Ptr_Array - | Type_Mode_Array => + | Type_Mode_Array + | Type_Mode_Record + | Type_Mode_Acc + | Type_Mode_Fat_Acc => R := Get_Var (Name_Info.Alias_Var); return Lp2M (R, Type_Info, Name_Info.Alias_Kind); when Type_Mode_Scalar => @@ -13268,9 +13285,6 @@ package body Translation is else return Lp2M (R, Type_Info, Name_Info.Alias_Kind); end if; - when Type_Mode_Record => - R := Get_Var (Name_Info.Alias_Var); - return Lp2M (R, Type_Info, Name_Info.Alias_Kind); when others => raise Internal_Error; end case; @@ -15862,6 +15876,9 @@ package body Translation is return Translate_Fat_Array_Type_Conversion (Expr, Expr_Type, Res_Type, Loc); end if; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + return Expr; when others => Error_Kind ("translate_type_conversion", Res_Type); end case; @@ -27591,9 +27608,7 @@ package body Translation is O_Storage_External, Ghdl_Rtin_Block); case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Declaration => - Info.Block_Rti_Const := Rti; - when Iir_Kind_Package_Declaration => + | Iir_Kind_Package_Declaration => declare Prev : Rti_Block; begin @@ -27601,8 +27616,16 @@ package body Translation is Generate_Declaration_Chain (Get_Declaration_Chain (Lib_Unit)); Pop_Rti_Node (Prev); - Info.Package_Rti_Const := Rti; end; + when others => + null; + end case; + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration => + Info.Block_Rti_Const := Rti; + when Iir_Kind_Package_Declaration => + Info.Package_Rti_Const := Rti; when Iir_Kind_Package_Body => -- Replace package declaration RTI with the body one. Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const := Rti; |