From 8b3ec6b7edf3aedbe7084609881571d1603e9621 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 24 Jun 2014 22:09:22 +0200 Subject: Use library unit instead of design unit. --- canon.adb | 20 +++---- configuration.adb | 9 +-- errorout.adb | 2 +- evaluation.adb | 3 +- iirs.adb | 23 +++++--- iirs.ads | 46 ++++++++++------ iirs_utils.adb | 15 ++++- libraries.adb | 16 ++---- sem.adb | 135 +++++++++++++++++++++------------------------ sem_assocs.adb | 2 +- sem_names.adb | 53 +++++++----------- sem_names.ads | 4 +- sem_scopes.adb | 138 ++++++++++++++++++++++++---------------------- sem_specs.adb | 97 ++++++++++++++++---------------- simulate/elaboration.adb | 37 ++++--------- simulate/execution.adb | 27 ++++----- simulate/simulation.adb | 3 +- std_package.adb | 36 ++++++++---- std_package.ads | 9 +++ translate/trans_be.adb | 2 +- translate/translation.adb | 25 ++++----- 21 files changed, 351 insertions(+), 351 deletions(-) diff --git a/canon.adb b/canon.adb index eda0a507a..32f000417 100644 --- a/canon.adb +++ b/canon.adb @@ -1723,7 +1723,6 @@ package body Canon is Binding : Iir) is Aspect : Iir; - Unit : Iir; begin if Binding = Null_Iir then return; @@ -1735,20 +1734,17 @@ package body Canon is case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => if Get_Architecture (Aspect) /= Null_Iir then - Unit := Aspect; + Add_Dependence (Top, Aspect); else - Unit := Get_Entity (Aspect); + Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect))); end if; when Iir_Kind_Entity_Aspect_Configuration => - Unit := Get_Configuration (Aspect); + Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect))); when Iir_Kind_Entity_Aspect_Open => - Unit := Null_Iir; + null; when others => Error_Kind ("add_binding_indication_dependence", Aspect); end case; - if Unit /= Null_Iir then - Add_Dependence (Top, Unit); - end if; end Add_Binding_Indication_Dependence; -- Canon the component_configuration or configuration_specification CFG. @@ -1825,7 +1821,7 @@ package body Canon is if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity and then Get_Architecture (Entity_Aspect) = Null_Iir then - Entity := Get_Library_Unit (Get_Entity (Entity_Aspect)); + Entity := Get_Entity (Entity_Aspect); if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then raise Internal_Error; end if; @@ -2664,24 +2660,24 @@ package body Canon is (Arch : Iir_Architecture_Declaration) return Iir_Design_Unit is - Loc : Location_Type; + Loc : constant Location_Type := Get_Location (Arch); Config : Iir_Configuration_Declaration; Res : Iir_Design_Unit; Entity : Iir_Entity_Declaration; Blk_Cfg : Iir_Block_Configuration; begin - Loc := Get_Location (Arch); Res := Create_Iir (Iir_Kind_Design_Unit); Set_Location (Res, Loc); Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch))); Set_Date_State (Res, Date_Analyze); Set_Date (Res, Date_Uptodate); + Config := Create_Iir (Iir_Kind_Configuration_Declaration); Set_Location (Config, Loc); Set_Library_Unit (Res, Config); Set_Design_Unit (Config, Res); Entity := Get_Entity (Arch); - Set_Entity (Config, Get_Design_Unit (Entity)); + Set_Entity (Config, Entity); Set_Dependence_List (Res, Create_Iir_List); Add_Dependence (Res, Get_Design_Unit (Entity)); Add_Dependence (Res, Get_Design_Unit (Arch)); diff --git a/configuration.adb b/configuration.adb index ab03bca3b..8c75f8ac1 100644 --- a/configuration.adb +++ b/configuration.adb @@ -125,7 +125,7 @@ package body Configuration is -- find all sub-configuration Libraries.Load_Design_Unit (Unit, From); Lib_Unit := Get_Library_Unit (Unit); - Add_Design_Unit (Get_Entity (Lib_Unit), Unit); + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); declare Blk : Iir_Block_Configuration; Prev_Configuration : Iir_Configuration_Declaration; @@ -248,12 +248,12 @@ package body Configuration is case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => -- Add the entity. - Entity := Get_Entity (Aspect); + Entity_Lib := Get_Entity (Aspect); + Entity := Get_Design_Unit (Entity_Lib); Add_Design_Unit (Entity, Aspect); -- Extract and add the architecture. Arch := Get_Architecture (Aspect); - Entity_Lib := Get_Library_Unit (Entity); if Arch /= Null_Iir then case Get_Kind (Arch) is when Iir_Kind_Simple_Name => @@ -293,7 +293,8 @@ package body Configuration is end if; end if; when Iir_Kind_Entity_Aspect_Configuration => - Add_Design_Unit (Get_Configuration (Aspect), Aspect); + Add_Design_Unit + (Get_Design_Unit (Get_Configuration (Aspect)), Aspect); when Iir_Kind_Entity_Aspect_Open => null; when others => diff --git a/errorout.adb b/errorout.adb index d0d9aba8d..cd7f4f746 100644 --- a/errorout.adb +++ b/errorout.adb @@ -597,7 +597,7 @@ package body Errorout is if Id /= Null_Identifier then return Disp_Identifier (Node, "configuration"); else - Ent := Get_Library_Unit (Get_Entity (Node)); + Ent := Get_Entity (Node); Arch := Get_Block_Specification (Get_Block_Configuration (Node)); return "default configuration of " diff --git a/evaluation.adb b/evaluation.adb index f193d1c66..0444b0a5b 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -2765,8 +2765,7 @@ package body Evaluation is Path_Add_Element (Get_Parent (Prefix), Is_Instance); Path_Add_Name (Prefix); when Iir_Kind_Library_Declaration - | Iir_Kind_Design_Unit - | Iir_Kind_Package_Declaration + | Iir_Kinds_Library_Unit_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Implicit_Function_Declaration diff --git a/iirs.adb b/iirs.adb index 68723d648..5f057edad 100644 --- a/iirs.adb +++ b/iirs.adb @@ -1775,14 +1775,14 @@ package body Iirs is function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is begin Check_Kind_For_Architecture (Target); - return Get_Field2 (Target); + return Get_Field3 (Target); end Get_Architecture; procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir) is begin Check_Kind_For_Architecture (Target); - Set_Field2 (Target, Arch); + Set_Field3 (Target, Arch); end Set_Architecture; procedure Check_Kind_For_Block_Specification (Target : Iir) is @@ -1859,6 +1859,10 @@ package body Iirs is | Iir_Kind_Subtype_Declaration | Iir_Kind_Nature_Declaration | Iir_Kind_Subnature_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Architecture_Declaration | Iir_Kind_Unit_Declaration | Iir_Kind_Component_Declaration | Iir_Kind_Group_Declaration @@ -1983,13 +1987,13 @@ package body Iirs is function Get_Entity (Decl : Iir) return Iir is begin Check_Kind_For_Entity (Decl); - return Get_Field4 (Decl); + return Get_Field2 (Decl); end Get_Entity; procedure Set_Entity (Decl : Iir; Entity : Iir) is begin Check_Kind_For_Entity (Decl); - Set_Field4 (Decl, Entity); + Set_Field2 (Decl, Entity); end Set_Entity; procedure Check_Kind_For_Package (Target : Iir) is @@ -2028,13 +2032,13 @@ package body Iirs is function Get_Package_Body (Pkg : Iir) return Iir_Package_Body is begin Check_Kind_For_Package_Body (Pkg); - return Get_Field4 (Pkg); + return Get_Field2 (Pkg); end Get_Package_Body; procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body) is begin Check_Kind_For_Package_Body (Pkg); - Set_Field4 (Pkg, Decl); + Set_Field2 (Pkg, Decl); end Set_Package_Body; procedure Check_Kind_For_Need_Body (Target : Iir) is @@ -3556,12 +3560,15 @@ package body Iirs is procedure Check_Kind_For_Visible_Flag (Target : Iir) is begin case Get_Kind (Target) is - when Iir_Kind_Design_Unit - | Iir_Kind_Record_Element_Constraint + when Iir_Kind_Record_Element_Constraint | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Nature_Declaration | Iir_Kind_Subnature_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Architecture_Declaration | Iir_Kind_Unit_Declaration | Iir_Kind_Library_Declaration | Iir_Kind_Component_Declaration diff --git a/iirs.ads b/iirs.ads index df91fa909..0d0892905 100644 --- a/iirs.ads +++ b/iirs.ads @@ -65,12 +65,11 @@ package Iirs is -- To add a new kind of node: -- the name should be of the form iir_kind_NAME -- add iir_kind_NAME in the definition of type iir_kind_type - -- add a declaration of access type of name iir_kind_NAME_acc -- document the node below: grammar, methods. -- for each methods, add the name if the case statement in the body -- (this enables the methods) - -- add an entry in create_iir and free_iir -- add an entry in disp_tree (debugging) + -- handle this node in Errorout.Disp_Node ------------------------------------------------- -- General methods (can be used on all nodes): -- @@ -181,8 +180,6 @@ package Iirs is -- -- Flag used during elaboration. Set when the file was already seen. -- Get/Set_Elab_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) -- Iir_Kind_Library_Clause (Short) -- Note: a library_clause node is created for every logical_name. @@ -410,11 +407,11 @@ package Iirs is -- -- Parse: a name -- Sem: a design unit - -- Get/Set_Entity (Field4) + -- Get/Set_Entity (Field2) -- -- parse: a simple name. -- sem: an architecture declaration or NULL_IIR. - -- Get/Set_Architecture (Field2) + -- Get/Set_Architecture (Field3) -- Iir_Kind_Entity_Aspect_Open (Short) @@ -611,12 +608,16 @@ package Iirs is -- -- Get/Set_Identifier (Field3) -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- -- Get/Set_Concurrent_Statement_Chain (Field5) -- -- Get/Set_Generic_Chain (Field6) -- -- Get/Set_Port_Chain (Field7) -- + -- Get/Set_Visible_Flag (Flag4) + -- -- Get/Set_Is_Within_Flag (Flag5) -- Iir_Kind_Architecture_Declaration (Medium) @@ -626,12 +627,13 @@ package Iirs is -- -- Get_Declaration_Chain (Field1) -- - -- Get/Set_Identifier (Field3) - -- -- Entity declaration for the architecture. -- Before the semantic pass, it can be a name. - -- Get/Set_Entity (Field4) + -- Get/Set_Entity (Field2) -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) -- Get/Set_Concurrent_Statement_Chain (Field5) -- -- The default configuration created by canon. This is a design unit. @@ -639,6 +641,8 @@ package Iirs is -- -- Get/Set_Foreign_Flag (Flag3) -- + -- Get/Set_Visible_Flag (Flag4) + -- -- Get/Set_Is_Within_Flag (Flag5) -- Iir_Kind_Configuration_Declaration (Short) @@ -648,13 +652,17 @@ package Iirs is -- -- Get_Declaration_Chain (Field1) -- - -- Get/Set_Identifier (Field3) - -- -- Set the entity of a configuration (a design_unit) -- Before the semantic pass, it can be an identifier. - -- Get/Set_Entity (Field4) + -- Get/Set_Entity (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) -- -- Get/Set_Block_Configuration (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) -- Iir_Kind_Package_Declaration (Medium) -- @@ -663,15 +671,19 @@ package Iirs is -- -- Get_Declaration_Chain (Field1) -- - -- Get/Set_Identifier (Field3) + -- Get/Set_Package_Body (Field2) -- - -- Get/Set_Package_Body (Field4) + -- Get/Set_Identifier (Field3) -- -- Get/Set_Generic_Chain (Field6) -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- -- Get/Set_Generic_Map_Aspect_Chain (Field8) -- -- Get/Set_Need_Body (Flag1) + -- + -- Get/Set_Visible_Flag (Flag4) -- Iir_Kind_Package_Body (Short) -- Note: a body is not a declaration, that's the reason why there is no @@ -4457,7 +4469,7 @@ package Iirs is function Get_Same_Alternative_Flag (Target : Iir) return Boolean; procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean); - -- Field: Field2 + -- Field: Field3 function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir; procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir); @@ -4500,7 +4512,7 @@ package Iirs is function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir; procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir); - -- Field: Field4 + -- Field: Field2 function Get_Entity (Decl : Iir) return Iir; procedure Set_Entity (Decl : Iir; Entity : Iir); @@ -4510,7 +4522,7 @@ package Iirs is procedure Set_Package (Package_Body : Iir; Decl : Iir_Package_Declaration); -- The package body corresponding to the package declaration. - -- Field: Field4 + -- Field: Field2 function Get_Package_Body (Pkg : Iir) return Iir_Package_Body; procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body); diff --git a/iirs_utils.adb b/iirs_utils.adb index 7ee171c28..fa69e8e23 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -274,6 +274,15 @@ package body Iirs_Utils is if Unit = Target then return; end if; + + case Get_Kind (Unit) is + when Iir_Kind_Design_Unit + | Iir_Kind_Entity_Aspect_Entity => + null; + when others => + Error_Kind ("add_dependence", Unit); + end case; + Add_Element (Get_Dependence_List (Target), Unit); end Add_Dependence; @@ -801,10 +810,10 @@ package body Iirs_Utils is when Iir_Kind_Component_Declaration => return Aspect; when Iir_Kind_Entity_Aspect_Entity => - return Get_Library_Unit (Get_Entity (Aspect)); + return Get_Entity (Aspect); when Iir_Kind_Entity_Aspect_Configuration => - Inst := Get_Library_Unit (Get_Configuration (Aspect)); - return Get_Library_Unit (Get_Entity (Inst)); + Inst := Get_Configuration (Aspect); + return Get_Entity (Inst); when Iir_Kind_Entity_Aspect_Open => return Null_Iir; when others => diff --git a/libraries.adb b/libraries.adb index 91dd27d90..e48707d8e 100644 --- a/libraries.adb +++ b/libraries.adb @@ -148,7 +148,7 @@ package body Libraries is -- Architectures are put with the entity identifier. Id := Get_Identifier (Get_Entity (Lib_Unit)); when others => - Error_Kind ("get_id_for_unit_hash", Lib_Unit); + Error_Kind ("get_Hash_Id_For_Unit", Lib_Unit); end case; return Id mod Unit_Hash_Length; end Get_Hash_Id_For_Unit; @@ -503,7 +503,6 @@ package body Libraries is end if; Set_Identifier (Library_Unit, Current_Identifier); Set_Identifier (Design_Unit, Current_Identifier); - Set_Visible_Flag (Design_Unit, True); if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Declaration then Scan_Expect (Tok_Of); @@ -1390,16 +1389,9 @@ package body Libraries is return Find_Primary_Unit (Lib, Get_Suffix_Identifier (Unit)); end; when Iir_Kind_Entity_Aspect_Entity => - declare - Prim : Iir_Design_Unit; - begin - Prim := Find_Design_Unit (Get_Entity (Unit)); - if Prim = Null_Iir then - return Null_Iir; - end if; - return Find_Secondary_Unit - (Prim, Get_Identifier (Get_Architecture (Unit))); - end; + return Find_Secondary_Unit + (Get_Design_Unit (Get_Entity (Unit)), + Get_Identifier (Get_Architecture (Unit))); when others => Error_Kind ("find_design_unit", Unit); end case; diff --git a/sem.adb b/sem.adb index f8c9dc24c..a78513735 100644 --- a/sem.adb +++ b/sem.adb @@ -58,14 +58,11 @@ package body Sem is end Add_Dependence; -- LRM 1.1 Entity declaration. - procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration) - is - Unit : Iir_Design_Unit; + procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration) is begin - Unit := Get_Design_Unit (Entity); Xrefs.Xref_Decl (Entity); - Sem_Scopes.Add_Name (Unit); - Set_Visible_Flag (Unit, True); + Sem_Scopes.Add_Name (Entity); + Set_Visible_Flag (Entity, True); Set_Is_Within_Flag (Entity, True); @@ -94,51 +91,49 @@ package body Sem is is Name : Iir; Library : Iir_Library_Declaration; - Entity_Unit : Iir; - Entity_Library : Iir; + Entity : Iir; begin Name := Get_Entity (Library_Unit); Library := Get_Library (Get_Design_File (Get_Design_Unit (Library_Unit))); if Get_Kind (Name) = Iir_Kind_Simple_Name then - Entity_Unit := Libraries.Load_Primary_Unit + Entity := Libraries.Load_Primary_Unit (Library, Get_Identifier (Name), Library_Unit); - if Entity_Unit = Null_Iir then + if Entity = Null_Iir then Error_Msg_Sem ("entity " & Disp_Node (Name) & " was not analysed", Library_Unit); return Null_Iir; end if; - Set_Named_Entity (Name, Entity_Unit); + Entity := Get_Library_Unit (Entity); + Set_Named_Entity (Name, Entity); else Sem_Name (Name, False); - Entity_Unit := Get_Named_Entity (Name); - if Entity_Unit = Error_Mark then + Entity := Get_Named_Entity (Name); + if Entity = Error_Mark then return Null_Iir; end if; end if; - if Get_Kind (Entity_Unit) = Iir_Kind_Design_Unit then - Entity_Library := Get_Library_Unit (Entity_Unit); - Xrefs.Xref_Ref (Name, Entity_Library); - if Get_Kind (Entity_Library) = Iir_Kind_Entity_Declaration then - -- LRM 1.2 Architecture bodies - -- For a given design entity, both the entity declaration and the - -- associated architecture body must reside in the same library. - - -- LRM 1.3 Configuration Declarations - -- For a configuration of a given design entity, both the - -- configuration declaration and the corresponding entity - -- declaration must reside in the same library. - if Get_Library (Get_Design_File (Entity_Unit)) /= Library then - Error_Msg_Sem - (Disp_Node (Entity_Library) & " does not reside in " - & Disp_Node (Library), Library_Unit); - return Null_Iir; - end if; - return Entity_Unit; + Xrefs.Xref_Ref (Name, Entity); + if Get_Kind (Entity) = Iir_Kind_Entity_Declaration then + -- LRM 1.2 Architecture bodies + -- For a given design entity, both the entity declaration and the + -- associated architecture body must reside in the same library. + + -- LRM 1.3 Configuration Declarations + -- For a configuration of a given design entity, both the + -- configuration declaration and the corresponding entity + -- declaration must reside in the same library. + if Get_Library (Get_Design_File (Get_Design_Unit (Entity))) /= Library + then + Error_Msg_Sem + (Disp_Node (Entity) & " does not reside in " + & Disp_Node (Library), Library_Unit); + return Null_Iir; end if; + return Entity; end if; - Error_Msg_Sem ("entity name expected, found " & Disp_Node (Entity_Unit), + Error_Msg_Sem ("entity name expected, found " & Disp_Node (Entity), Library_Unit); return Null_Iir; end Sem_Entity_Name; @@ -146,17 +141,16 @@ package body Sem is -- LRM 1.2 Architecture bodies. procedure Sem_Architecture_Declaration (Arch: Iir_Architecture_Declaration) is - Unit : Iir_Design_Unit; Entity_Unit : Iir_Design_Unit; Entity_Library : Iir_Entity_Declaration; begin Xrefs.Xref_Decl (Arch); -- First, find the entity. - Entity_Unit := Sem_Entity_Name (Arch); - if Entity_Unit = Null_Iir then + Entity_Library := Sem_Entity_Name (Arch); + if Entity_Library = Null_Iir then return; end if; - Entity_Library := Get_Library_Unit (Entity_Unit); + Entity_Unit := Get_Design_Unit (Entity_Library); -- LRM93 11.4 -- In each case, the second unit depends on the first unit. @@ -173,7 +167,8 @@ package body Sem is -- Makes the entity name visible. -- FIXME: quote LRM. - Sem_Scopes.Add_Name (Entity_Unit, Get_Identifier (Entity_Unit), False); + Sem_Scopes.Add_Name + (Entity_Library, Get_Identifier (Entity_Library), False); -- LRM 10.1 Declarative Region -- 1. An entity declaration, together with a corresponding architecture @@ -188,9 +183,8 @@ package body Sem is -- declarative part of the corresponding entity declaration. -- -- FIXME: before VHDL-02, an architecture is not a declaration. - Unit := Get_Design_Unit (Arch); - Sem_Scopes.Add_Name (Unit, Get_Identifier (Unit), True); - Set_Visible_Flag (Unit, True); + Sem_Scopes.Add_Name (Arch, Get_Identifier (Arch), True); + Set_Visible_Flag (Arch, True); -- LRM02 10.1 Declarative region -- The declarative region associated with an architecture body is @@ -539,28 +533,29 @@ package body Sem is -- LRM 1.3 Configuration Declarations. procedure Sem_Configuration_Declaration (Decl: Iir) is - Unit : Iir_Design_Unit; - Entity_Design: Iir_Design_Unit; + Entity: Iir_Entity_Declaration; + Entity_Unit : Iir_Design_Unit; begin Xref_Decl (Decl); -- LRM 1.3 -- The entity name identifies the name of the entity declaration that -- defines the design entity at the apex of the design hierarchy. - Entity_Design := Sem_Entity_Name (Decl); - if Entity_Design = Null_Iir then + Entity := Sem_Entity_Name (Decl); + if Entity = Null_Iir then return; end if; - Set_Entity (Decl, Entity_Design); + Set_Entity (Decl, Entity); + Entity_Unit := Get_Design_Unit (Entity); -- LRM 11.4 -- A primary unit whose name is referenced within a given design unit -- must be analyzed prior to the analysis of the given design unit. - Add_Dependence (Entity_Design); + Add_Dependence (Entity_Unit); - Unit := Get_Design_Unit (Decl); - Sem_Scopes.Add_Name (Unit); - Set_Visible_Flag (Unit, True); + Sem_Scopes.Add_Name (Entity); + + Set_Visible_Flag (Decl, True); -- LRM 10.1 Declarative Region -- 2. A configuration declaration. @@ -572,8 +567,8 @@ package body Sem is -- it be an external block defined by a design entity or an internal -- block defined by a block statement) extends into a configuration -- declaration that configures the given block. - Add_Context_Clauses (Entity_Design); - Sem_Scopes.Add_Entity_Declarations (Get_Library_Unit (Entity_Design)); + Add_Context_Clauses (Entity_Unit); + Sem_Scopes.Add_Entity_Declarations (Entity); Sem_Declaration_Chain (Decl); -- GHDL: no need to check for missing subprogram bodies, since they are @@ -618,7 +613,8 @@ package body Sem is -- block configuration for an external block whose interface -- is defined by that entity declaration. Design := Libraries.Load_Secondary_Unit - (Get_Entity (Father), Get_Identifier (Block_Spec), + (Get_Design_Unit (Get_Entity (Father)), + Get_Identifier (Block_Spec), Block_Conf); if Design = Null_Iir then Error_Msg_Sem @@ -680,7 +676,8 @@ package body Sem is end if; Design := Libraries.Load_Secondary_Unit - (Get_Entity (Entity_Aspect), Get_Identifier (Block_Spec), + (Get_Design_Unit (Get_Entity (Entity_Aspect)), + Get_Identifier (Block_Spec), Block_Conf); if Design = Null_Iir then Error_Msg_Sem @@ -1300,8 +1297,9 @@ package body Sem is begin if not Are_Trees_Equal (Subprg, Spec) then -- FIXME: should explain why it does not conform ? - Error_Msg_Sem ("body does not conform with specification at " - & Disp_Location (Spec), Subprg); + Error_Msg_Sem ("body of " & Disp_Node (Subprg) + & " does not conform with specification at " + & Disp_Location (Spec), Subprg); end if; end Check_Conformance_Rules; @@ -1798,7 +1796,7 @@ package body Sem is case Get_Kind (Subprg) is when Iir_Kind_Function_Declaration => Kind := K_Function; - Subprg_Bod := Null_Iir; + Subprg_Bod := Get_Subprogram_Body (Subprg); Subprg_Depth := Get_Subprogram_Depth (Subprg); if Get_Pure_Flag (Subprg) then Depth := Iir_Depth_Pure; @@ -1898,7 +1896,8 @@ package body Sem is -- FIXME: check the compare. Depth_Callee := Iir_Depth_Impure; if Kind = K_Function then - Error_Pure (Subprg, Callee, Null_Iir); + -- FIXME: report call location + Error_Pure (Subprg_Bod, Callee, Null_Iir); end if; end if; @@ -2175,8 +2174,8 @@ package body Sem is Implicit : Implicit_Signal_Declaration_Type; begin Unit := Get_Design_Unit (Decl); - Sem_Scopes.Add_Name (Unit); - Set_Visible_Flag (Unit, True); + Sem_Scopes.Add_Name (Decl); + Set_Visible_Flag (Decl, True); Xref_Decl (Decl); -- Identify IEEE.Std_Logic_1164 for VHDL08. @@ -2287,11 +2286,12 @@ package body Sem is Sem_Name (Prefix, False); Prefix_Name := Get_Named_Entity (Prefix); if Prefix_Name = Error_Mark then + -- FIXME: continue with the clauses return; end if; -- LRM 10.4 Use Clauses - + -- -- If the suffix of the selected name is [...], then the -- selected name identifies only the declaration(s) of that -- [...] contained within the package or library denoted by @@ -2305,15 +2305,8 @@ package body Sem is case Get_Kind (Prefix_Name) is when Iir_Kind_Library_Declaration => null; - when Iir_Kind_Design_Unit => - if Get_Kind (Get_Library_Unit (Prefix_Name)) - /= Iir_Kind_Package_Declaration - then - Error_Msg_Sem ("design unit is not a package", Prefix); - return; - end if; - Libraries.Load_Design_Unit (Prefix_Name, Clause); - Add_Dependence (Prefix_Name); + when Iir_Kind_Package_Declaration => + null; when others => Error_Msg_Sem ("prefix must designate a package or a library", Prefix); @@ -2445,7 +2438,7 @@ package body Sem is Sem_Scopes.Add_Name (Get_Library (Get_Design_File (Design_Unit)), Std_Names.Name_Work, False); - Sem_Scopes.Use_All_Names (Std_Standard_Unit); + Sem_Scopes.Use_All_Names (Standard_Package); if Get_Dependence_List (Design_Unit) = Null_Iir_List then Set_Dependence_List (Design_Unit, Create_Iir_List); end if; diff --git a/sem_assocs.adb b/sem_assocs.adb index ff7c5ebfa..77ffcd559 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -1475,7 +1475,7 @@ package body Sem_Assocs is if Inter = Null_Iir then if Finish then Error_Msg_Sem - ("too many arguments for " & Disp_Node (Loc), Assoc); + ("too many actuals for " & Disp_Node (Loc), Assoc); end if; Match := False; return; diff --git a/sem_names.adb b/sem_names.adb index e7bfe6edf..45ce37779 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1237,7 +1237,7 @@ package body Sem_Names is Pfx : Iir; begin case Get_Kind (Res) is - when Iir_Kind_Design_Unit => + when Iir_Kinds_Library_Unit_Declaration => return; when Iir_Kind_Block_Statement => -- Part of an expanded name @@ -1338,6 +1338,14 @@ package body Sem_Names is -- not overloaded. Res := Get_Declaration (Interpretation); + -- For a design unit, return the library unit + if Get_Kind (Res) = Iir_Kind_Design_Unit then + -- FIXME: should replace interpretation ? + Libraries.Load_Design_Unit (Res, Name); + Sem.Add_Dependence (Res); + Res := Get_Library_Unit (Res); + end if; + if not Get_Visible_Flag (Res) then if Flag_Relaxed_Rules and then Get_Kind (Res) in Iir_Kinds_Object_Declaration @@ -1590,14 +1598,14 @@ package body Sem_Names is & """ not found in " & Disp_Node (Prefix), Name); else Sem.Add_Dependence (Res); + Res := Get_Library_Unit (Res); end if; when Iir_Kind_Process_Statement | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Design_Unit --- | Iir_Kind_Architecture_Declaration --- | Iir_Kind_Entity_Declaration --- | Iir_Kind_Package_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration | Iir_Kind_Generate_Statement | Iir_Kind_Block_Statement | Iir_Kind_For_Loop_Statement => @@ -2098,7 +2106,7 @@ package body Sem_Names is when Iir_Kind_Psl_Declaration => Res := Sem_Psl.Sem_Psl_Name (Name); - when Iir_Kind_Design_Unit => + when Iir_Kinds_Library_Unit_Declaration => Error_Msg_Sem ("function name is a design unit", Name); when others => @@ -2265,11 +2273,10 @@ package body Sem_Names is | Iir_Kind_Unit_Declaration | Iir_Kinds_Sequential_Statement | Iir_Kinds_Concurrent_Statement - | Iir_Kind_Component_Declaration => + | Iir_Kind_Component_Declaration + | Iir_Kinds_Library_Unit_Declaration => -- FIXME: to complete null; - when Iir_Kind_Design_Unit => - Sem.Add_Dependence (Prefix); when others => Error_Kind ("sem_user_attribute", Prefix); end case; @@ -2855,7 +2862,7 @@ package body Sem_Names is | Iir_Kind_Group_Declaration | Iir_Kind_Group_Template_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_Design_Unit + | Iir_Kinds_Library_Unit_Declaration | Iir_Kind_Non_Object_Alias_Declaration => null; @@ -3451,25 +3458,6 @@ package body Sem_Names is end if; end Check_Kind; - function Check_Kind_Unit (Res: Iir; Kind : Iir_Kind; Str: String) - return Iir - is - Res_Kind : Iir_Kind; - begin - if Get_Kind (Res) /= Iir_Kind_Design_Unit then - Error (Res, Str); - return Null_Iir; - end if; - - Res_Kind := Get_Kind (Get_Library_Unit (Res)); - if Res_Kind /= Kind then - Error (Res, Str); - return Null_Iir; - else - return Res; - end if; - end Check_Kind_Unit; - Res: Iir; begin Sem_Name (Name, False); @@ -3525,11 +3513,10 @@ package body Sem_Names is when Decl_Label => null; when Decl_Entity => - Res := Check_Kind_Unit - (Res, Iir_Kind_Entity_Declaration, "entity"); + Res := Check_Kind (Res, Iir_Kind_Entity_Declaration, "entity"); when Decl_Configuration => - Res := Check_Kind_Unit (Res, Iir_Kind_Configuration_Declaration, - "configuration"); + Res := Check_Kind (Res, Iir_Kind_Configuration_Declaration, + "configuration"); when Decl_Group_Template => Res := Check_Kind (Res, Iir_Kind_Group_Template_Declaration, "group template"); diff --git a/sem_names.ads b/sem_names.ads index b48cd7b6a..8e9ffd0ba 100644 --- a/sem_names.ads +++ b/sem_names.ads @@ -41,8 +41,8 @@ package Sem_Names is -- To be used only for names (weakly) semantized by sem_name_soft. procedure Sem_Name_Clean (Name : Iir); - -- Return TRUE if NAME is a name that designate an object. - -- Only in this case, base_name is defined. + -- Return TRUE if NAME is a name that designate an object (ie a constant, + -- a variable, a signal or a file). function Is_Object_Name (Name : Iir) return Boolean; -- Return an object node if NAME designates an object (ie either is an diff --git a/sem_scopes.adb b/sem_scopes.adb index 9eac43432..810c70d43 100644 --- a/sem_scopes.adb +++ b/sem_scopes.adb @@ -791,6 +791,7 @@ package body Sem_Scopes is | Iir_Kind_Terminal_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Package_Declaration + | Iir_Kind_Configuration_Declaration | Iir_Kinds_Concurrent_Statement | Iir_Kinds_Sequential_Statement => Handle_Decl (Decl, Arg); @@ -844,8 +845,6 @@ package body Sem_Scopes is -- -- May be empty. -- Handle_Decl (El, Arg); -- end if; - when Iir_Kind_Design_Unit => - Handle_Decl (Decl, Arg); when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => @@ -918,67 +917,6 @@ package body Sem_Scopes is procedure Add_Declarations_List is new Iterator_Decl_List (Arg_Type => Boolean, Handle_Decl => Add_Declaration); - procedure Use_Library_All (Library : Iir_Library_Declaration) - is - Design_File : Iir_Design_File; - Design_Unit : Iir_Design_Unit; - Library_Unit : Iir; - begin - Design_File := Get_Design_File_Chain (Library); - while Design_File /= Null_Iir loop - Design_Unit := Get_First_Design_Unit (Design_File); - while Design_Unit /= Null_Iir loop - Library_Unit := Get_Library_Unit (Design_Unit); - if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then - Add_Name (Design_Unit, Get_Identifier (Design_Unit), True); - end if; - Design_Unit := Get_Chain (Design_Unit); - end loop; - Design_File := Get_Chain (Design_File); - end loop; - end Use_Library_All; - - procedure Use_Selected_Name (Name : Iir) is - begin - if Get_Kind (Name) = Iir_Kind_Overload_List then - Add_Declarations_List (Get_Overload_List (Name), True); - else - Add_Declaration (Name, True); - end if; - end Use_Selected_Name; - - procedure Use_All_Names (Name: Iir) is - begin - case Get_Kind (Name) is - when Iir_Kind_Library_Declaration => - Use_Library_All (Name); - when Iir_Kind_Design_Unit => - -- The design unit is a package. - Add_Declarations - (Get_Declaration_Chain (Get_Library_Unit (Name)), True); - when others => - raise Internal_Error; - end case; - end Use_All_Names; - - procedure Add_Use_Clause (Clause : Iir_Use_Clause) - is - Name : Iir; - Cl : Iir_Use_Clause; - begin - Cl := Clause; - loop - Name := Get_Selected_Name (Cl); - if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then - Use_All_Names (Get_Named_Entity (Get_Prefix (Name))); - else - Use_Selected_Name (Get_Named_Entity (Name)); - end if; - Cl := Get_Use_Clause_Chain (Cl); - exit when Cl = Null_Iir; - end loop; - end Add_Use_Clause; - procedure Add_Declarations_From_Interface_Chain (Chain : Iir) is El: Iir; @@ -1021,11 +959,20 @@ package body Sem_Scopes is Add_Declarations_Of_Concurrent_Statement (Entity); end Add_Entity_Declarations; - -- Add declarations from a package into the current declarative region. - -- This is needed when a package body is analysed. + -- Add declarations from a package into the current declarative region. + -- (for a use clause or when a package body is analyzed) + procedure Add_Package_Declarations + (Decl: Iir_Package_Declaration; Potentially : Boolean) + is + begin + Add_Declarations (Get_Declaration_Chain (Decl), Potentially); + end Add_Package_Declarations; + + -- Add declarations from a package into the current declarative region. + -- This is needed when a package body is analysed. procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is begin - Add_Declarations (Get_Declaration_Chain (Decl), False); + Add_Package_Declarations (Decl, False); end Add_Package_Declarations; procedure Add_Component_Declarations (Component: Iir_Component_Declaration) @@ -1057,6 +1004,65 @@ package body Sem_Scopes is Add_Declarations_Of_Concurrent_Statement (Decl); end Extend_Scope_Of_Block_Declarations; + procedure Use_Library_All (Library : Iir_Library_Declaration) + is + Design_File : Iir_Design_File; + Design_Unit : Iir_Design_Unit; + Library_Unit : Iir; + begin + Design_File := Get_Design_File_Chain (Library); + while Design_File /= Null_Iir loop + Design_Unit := Get_First_Design_Unit (Design_File); + while Design_Unit /= Null_Iir loop + Library_Unit := Get_Library_Unit (Design_Unit); + if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then + Add_Name (Design_Unit, Get_Identifier (Design_Unit), True); + end if; + Design_Unit := Get_Chain (Design_Unit); + end loop; + Design_File := Get_Chain (Design_File); + end loop; + end Use_Library_All; + + procedure Use_Selected_Name (Name : Iir) is + begin + if Get_Kind (Name) = Iir_Kind_Overload_List then + Add_Declarations_List (Get_Overload_List (Name), True); + else + Add_Declaration (Name, True); + end if; + end Use_Selected_Name; + + procedure Use_All_Names (Name: Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Library_Declaration => + Use_Library_All (Name); + when Iir_Kind_Package_Declaration => + Add_Package_Declarations (Name, True); + when others => + raise Internal_Error; + end case; + end Use_All_Names; + + procedure Add_Use_Clause (Clause : Iir_Use_Clause) + is + Name : Iir; + Cl : Iir_Use_Clause; + begin + Cl := Clause; + loop + Name := Get_Selected_Name (Cl); + if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then + Use_All_Names (Get_Named_Entity (Get_Prefix (Name))); + else + Use_Selected_Name (Get_Named_Entity (Name)); + end if; + Cl := Get_Use_Clause_Chain (Cl); + exit when Cl = Null_Iir; + end loop; + end Add_Use_Clause; + -- Debugging procedure Disp_Detailed_Interpretations (Ident : Name_Id) is diff --git a/sem_specs.adb b/sem_specs.adb index 56dbd9e45..3c09fb787 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -62,19 +62,14 @@ package body Sem_Specs is use Tokens; begin case Get_Kind (Decl) is - when Iir_Kind_Design_Unit => - case Get_Kind (Get_Library_Unit (Decl)) is - when Iir_Kind_Entity_Declaration => - return Tok_Entity; - when Iir_Kind_Architecture_Declaration => - return Tok_Architecture; - when Iir_Kind_Configuration_Declaration => - return Tok_Configuration; - when Iir_Kind_Package_Declaration => - return Tok_Package; - when others => - Error_Kind ("get_entity_class_kind(unit)", Decl); - end case; + when Iir_Kind_Entity_Declaration => + return Tok_Entity; + when Iir_Kind_Architecture_Declaration => + return Tok_Architecture; + when Iir_Kind_Configuration_Declaration => + return Tok_Configuration; + when Iir_Kind_Package_Declaration => + return Tok_Package; when Iir_Kind_Procedure_Declaration | Iir_Kind_Implicit_Procedure_Declaration => return Tok_Procedure; @@ -197,7 +192,7 @@ package body Sem_Specs is | Tok_Architecture | Tok_Configuration | Tok_Package => - if Decl /= Get_Current_Design_Unit then + if Get_Design_Unit (Decl) /= Get_Current_Design_Unit then Error_Msg_Sem (Disp_Node (Attr) & " must appear immediatly " & "within " & Disp_Node (Decl), Attr); return; @@ -285,36 +280,36 @@ package body Sem_Specs is (Flags.Vhdl_Std <= Vhdl_93c and then Get_Identifier (Attr_Decl) = Std_Names.Name_Foreign) then + -- LRM93 12.4 + -- The 'FOREIGN attribute may be associated only with + -- architectures or with subprograms. + case Get_Entity_Class (Attr) is + when Tok_Architecture => + null; + + when Tok_Function + | Tok_Procedure => + -- LRM93 12.4 + -- In the latter case, the attribute specification must + -- appear in the declarative part in which the subprogram + -- is declared. + -- GHDL: huh, this is the case for any attributes. + null; + + when others => + Error_Msg_Sem + ("'FOREIGN allowed only for architectures and subprograms", + Attr); + return; + end case; + + Set_Foreign_Flag (Decl, True); + declare use Back_End; - Decl1 : Iir; begin - -- LRM93 12.4 - -- The 'FOREIGN attribute may be associated only with - -- architectures or with subprograms. - case Get_Entity_Class (Attr) is - when Tok_Architecture => - Decl1 := Get_Library_Unit (Decl); - - when Tok_Function - | Tok_Procedure => - -- LRM93 12.4 - -- In the latter case, the attribute specification must - -- appear in the declarative part in which the subprogram - -- is declared. - -- GHDL: huh, this is the case for any attributes. - Decl1 := Decl; - - when others => - Error_Msg_Sem - ("'FOREIGN allowed only for architectures and subprograms", - Attr); - return; - end case; - - Set_Foreign_Flag (Decl1, True); - if Back_End.Sem_Foreign /= null then - Back_End.Sem_Foreign.all (Decl); + if Sem_Foreign /= null then + Sem_Foreign.all (Decl); end if; end; end if; @@ -357,7 +352,7 @@ package body Sem_Specs is procedure Sem_Named_Entity (Ent : Iir) is begin case Get_Kind (Ent) is - when Iir_Kind_Design_Unit + when Iir_Kinds_Library_Unit_Declaration | Iir_Kinds_Concurrent_Statement | Iir_Kinds_Function_Declaration | Iir_Kinds_Procedure_Declaration @@ -519,7 +514,7 @@ package body Sem_Specs is | Iir_Kind_Architecture_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Declaration => - Sem_Named_Entity (Get_Design_Unit (Scope)); + Sem_Named_Entity (Scope); when others => null; end case; @@ -954,7 +949,7 @@ package body Sem_Specs is Arch := Get_Architecture (Aspect); if Arch /= Null_Iir then Arch_Unit := Libraries.Find_Secondary_Unit - (New_Entity, Get_Identifier (Arch)); + (Get_Design_Unit (New_Entity), Get_Identifier (Arch)); if Arch_Unit /= Null_Iir then Xref_Ref (Arch, Arch_Unit); end if; @@ -964,6 +959,8 @@ package body Sem_Specs is -- Note: the design needs the architecture. Add_Dependence (Aspect); end if; + return New_Entity; + when Iir_Kind_Entity_Aspect_Configuration => Conf := Get_Configuration (Aspect); Conf := Find_Declaration (Conf, Decl_Configuration); @@ -974,15 +971,14 @@ package body Sem_Specs is -- Note: dependency is added by Find_Declaration. Set_Configuration (Aspect, Conf); - Libraries.Load_Design_Unit (Conf, Aspect); - New_Entity := Get_Entity (Get_Library_Unit (Conf)); + return Get_Entity (Conf); + when Iir_Kind_Entity_Aspect_Open => return Null_Iir; + when others => Error_Kind ("sem_entity_aspect", Aspect); end case; - Libraries.Load_Design_Unit (New_Entity, Aspect); - return Get_Library_Unit (New_Entity); end Sem_Entity_Aspect; procedure Sem_Binding_Indication (Bind : Iir_Binding_Indication; @@ -1023,8 +1019,7 @@ package body Sem_Specs is else case Get_Kind (Primary_Entity_Aspect) is when Iir_Kind_Entity_Aspect_Entity => - Entity := Get_Library_Unit - (Get_Entity (Primary_Entity_Aspect)); + Entity := Get_Entity (Primary_Entity_Aspect); when others => Error_Kind ("sem_binding_indication", Primary_Entity_Aspect); @@ -1390,7 +1385,7 @@ package body Sem_Specs is Res := Create_Iir (Iir_Kind_Binding_Indication); Aspect := Create_Iir (Iir_Kind_Entity_Aspect_Entity); Location_Copy (Aspect, Parent); - Set_Entity (Aspect, Design_Unit); + Set_Entity (Aspect, Entity); Set_Entity_Aspect (Res, Aspect); -- LRM 5.2.2 diff --git a/simulate/elaboration.adb b/simulate/elaboration.adb index eb0d14b21..dc3a6250c 100644 --- a/simulate/elaboration.adb +++ b/simulate/elaboration.adb @@ -1416,22 +1416,20 @@ package body Elaboration is -- Direct instantiation declare Aspect : constant Iir := Component; - Entity_Unit : Iir; Arch : Iir; Config : Iir; begin case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => - Entity_Unit := Get_Entity (Aspect); Arch := Get_Architecture (Aspect); if Arch = Null_Iir then Arch := Libraries.Get_Latest_Architecture - (Get_Library_Unit (Entity_Unit)); + (Get_Entity (Aspect)); end if; - Config := Get_Default_Configuration_Declaration (Arch); + Config := Get_Library_Unit + (Get_Default_Configuration_Declaration (Arch)); when Iir_Kind_Entity_Aspect_Configuration => Config := Get_Configuration (Aspect); - Entity_Unit := Get_Entity (Config); Arch := Get_Block_Specification (Get_Block_Configuration (Config)); when Iir_Kind_Entity_Aspect_Open => @@ -1439,7 +1437,7 @@ package body Elaboration is when others => raise Internal_Error; end case; - Config := Get_Block_Configuration (Get_Library_Unit (Config)); + Config := Get_Block_Configuration (Config); Frame := Elaborate_Architecture (Arch, Config, Instance, Stmt, @@ -1670,7 +1668,6 @@ package body Elaboration is is Component : constant Iir_Component_Declaration := Get_Instantiated_Unit (Stmt); - Entity_Design : Iir_Design_Unit; Entity : Iir_Entity_Declaration; Arch_Name : Name_Id; Arch_Design : Iir_Design_Unit; @@ -1679,7 +1676,6 @@ package body Elaboration is pragma Unreferenced (Arch_Frame); Generic_Map_Aspect_Chain : Iir; Port_Map_Aspect_Chain : Iir; - Unit : Iir; Binding : Iir_Binding_Indication; Aspect : Iir; Sub_Conf : Iir; @@ -1730,9 +1726,9 @@ package body Elaboration is case Get_Kind (Aspect) is when Iir_Kind_Design_Unit => - Entity_Design := Aspect; + raise Internal_Error; when Iir_Kind_Entity_Aspect_Entity => - Entity_Design := Get_Entity (Aspect); + Entity := Get_Entity (Aspect); if Get_Architecture (Aspect) /= Null_Iir then Arch_Name := Get_Identifier (Get_Architecture (Aspect)); end if; @@ -1741,29 +1737,16 @@ package body Elaboration is raise Internal_Error; end if; declare - Cf : Iir; + Conf : constant Iir := Get_Configuration (Aspect); begin - Cf := Get_Configuration (Aspect); - Cf := Get_Library_Unit (Cf); - Entity_Design := Get_Entity (Cf); - Sub_Conf := Get_Block_Configuration (Cf); + Entity := Get_Entity (Conf); + Sub_Conf := Get_Block_Configuration (Conf); Arch := Get_Block_Specification (Sub_Conf); end; when others => Error_Kind ("elaborate_component_declaration0", Aspect); end case; - Unit := Get_Library_Unit (Entity_Design); - case Get_Kind (Unit) is - when Iir_Kind_Entity_Declaration => - Entity := Unit; - when Iir_Kind_Configuration_Declaration => - Entity_Design := Get_Entity (Unit); - Entity := Get_Library_Unit (Entity_Design); - when others => - Error_Kind ("elaborate_component_declaration2", Unit); - end case; - if Arch = Null_Iir then if Arch_Name = Null_Identifier then Arch := Libraries.Get_Latest_Architecture (Entity); @@ -1774,7 +1757,7 @@ package body Elaboration is Arch_Name := Get_Identifier (Arch); end if; Arch_Design := Libraries.Load_Secondary_Unit - (Entity_Design, Arch_Name, Stmt); + (Get_Design_Unit (Entity), Arch_Name, Stmt); if Arch_Design = Null_Iir then Error_Msg_Elab ("no architecture `" & Name_Table.Image (Arch_Name) & "' for " & Disp_Node (Entity), Stmt); diff --git a/simulate/execution.adb b/simulate/execution.adb index 0d9e42790..3568e9d75 100644 --- a/simulate/execution.adb +++ b/simulate/execution.adb @@ -24,7 +24,6 @@ with Errorout; use Errorout; with Evaluation; with Iirs_Utils; use Iirs_Utils; with Annotations; use Annotations; -with Flags; with Name_Table; with File_Operation; with Debugger; use Debugger; @@ -1962,32 +1961,29 @@ package body Execution is Index_Order : Order; -- Lower and upper bounds of the slice. Low, High: Iir_Index32; - - use Flags; begin Srange := Execute_Bounds (Block, Get_Suffix (Expr)); Prefix := Get_Prefix (Expr); - -- LRM93 §6.5: It is an error if either of the bounds of the - -- discrete range does not belong to the index range of the - -- prefixing array, unless the slice is a null slice. Execute_Name_With_Base (Block, Prefix, Base, Prefix_Array, Is_Sig); if Prefix_Array = null then raise Internal_Error; end if; - -- Check for null slice. + -- LRM93 6.5 + -- It is an error if the direction of the discrete range is not + -- the same as that of the index range of the array denoted by + -- the prefix of the slice name. if Srange.Dir /= Prefix_Array.Bounds.D (1).Dir then - if Vhdl_Std = Vhdl_87 then - Res := null; -- FIXME - return; - else - raise Internal_Error; - end if; + Error_Msg_Exec ("slice direction mismatch", Expr); end if; + -- LRM93 6.5 + -- It is an error if either of the bounds of the + -- discrete range does not belong to the index range of the + -- prefixing array, unless the slice is a null slice. Index_Order := Compare_Value (Srange.Left, Srange.Right); if (Srange.Dir = Iir_To and Index_Order = Greater) or (Srange.Dir = Iir_Downto and Index_Order = Less) @@ -2579,6 +2575,11 @@ package body Execution is (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr))); return Execute_Length (Res); + when Iir_Kind_Ascending_Array_Attribute => + Res := Execute_Indexes + (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr))); + return Boolean_To_Lit (Res.Dir = Iir_To); + when Iir_Kind_Event_Attribute => Res := Execute_Name (Block, Get_Prefix (Expr), True); return Boolean_To_Lit (Execute_Event_Attribute (Res)); diff --git a/simulate/simulation.adb b/simulate/simulation.adb index 3e04e38bc..304faa9b2 100644 --- a/simulate/simulation.adb +++ b/simulate/simulation.adb @@ -1592,8 +1592,7 @@ package body Simulation is Instance_Pool := Global_Pool'Access; Elaboration.Elaborate_Design (Top_Config); - Entity := Get_Library_Unit - (Get_Entity (Get_Library_Unit (Top_Config))); + Entity := Get_Entity (Get_Library_Unit (Top_Config)); if not Is_Empty (Expr_Pool) then raise Internal_Error; diff --git a/std_package.adb b/std_package.adb index a0160cb1b..2833584b9 100644 --- a/std_package.adb +++ b/std_package.adb @@ -313,7 +313,7 @@ package body Std_Package is Set_Parent (Std_Standard_File, Parent); Set_Design_File_Filename (Std_Standard_File, Std_Filename); Std_Standard_Unit := Create_Std_Iir (Iir_Kind_Design_Unit); - Set_Std_Identifier (Std_Standard_Unit, Name_Standard); + Set_Identifier (Std_Standard_Unit, Name_Standard); Set_First_Design_Unit (Std_Standard_File, Std_Standard_Unit); Set_Last_Design_Unit (Std_Standard_File, Std_Standard_Unit); Set_Design_File (Std_Standard_Unit, Std_Standard_File); @@ -338,7 +338,7 @@ package body Std_Package is -- Adding "package STANDARD is" Standard_Package := Create_Std_Iir (Iir_Kind_Package_Declaration); - Set_Identifier (Standard_Package, Name_Standard); + Set_Std_Identifier (Standard_Package, Name_Standard); Set_Need_Body (Standard_Package, False); Set_Library_Unit (Std_Standard_Unit, Standard_Package); @@ -745,14 +745,6 @@ package body Std_Package is Create_Array_Type (Bit_Vector_Type_Definition, Bit_Vector_Type, Bit_Type_Definition, Name_Bit_Vector); - if Vhdl_Std >= Vhdl_08 then - -- integer_vector type. - -- type integer_vector is array (natural range <>) of Integer; - Create_Array_Type - (Integer_Vector_Type_Definition, Integer_Vector_Type, - Integer_Type_Definition, Name_Integer_Vector); - end if; - -- time definition declare Time_Staticness : Iir_Staticness; @@ -952,6 +944,30 @@ package body Std_Package is Add_Decl (Function_Now); end; + -- VHDL 2008 + -- Vector types + if Vhdl_Std >= Vhdl_08 then + -- type Boolean_Vector is array (Natural range <>) of Boolean; + Create_Array_Type + (Boolean_Vector_Type_Definition, Boolean_Vector_Type, + Integer_Type_Definition, Name_Boolean_Vector); + + -- type integer_vector is array (natural range <>) of Integer; + Create_Array_Type + (Integer_Vector_Type_Definition, Integer_Vector_Type, + Integer_Type_Definition, Name_Integer_Vector); + + -- type Real_vector is array (natural range <>) of Real; + Create_Array_Type + (Real_Vector_Type_Definition, Real_Vector_Type, + Real_Type_Definition, Name_Real_Vector); + + -- type Real_vector is array (natural range <>) of Real; + Create_Array_Type + (Time_Vector_Type_Definition, Time_Vector_Type, + Time_Type_Definition, Name_Time_Vector); + end if; + -- VHDL93: -- type file_open_kind is (read_mode, write_mode, append_mode); if Vhdl_Std >= Vhdl_93c then diff --git a/std_package.ads b/std_package.ads index 1b7ae4f1c..eebb610b5 100644 --- a/std_package.ads +++ b/std_package.ads @@ -137,9 +137,18 @@ package Std_Package is Foreign_Attribute : Iir_Attribute_Declaration; -- For VHDL-08 + Boolean_Vector_Type_Definition : Iir_Array_Type_Definition; + Boolean_Vector_Type : Iir_Type_Declaration; + Integer_Vector_Type_Definition : Iir_Array_Type_Definition; Integer_Vector_Type : Iir_Type_Declaration; + Real_Vector_Type_Definition : Iir_Array_Type_Definition; + Real_Vector_Type : Iir_Type_Declaration; + + Time_Vector_Type_Definition : Iir_Array_Type_Definition; + Time_Vector_Type : Iir_Type_Declaration; + -- Internal use only. -- These types should be considered like universal types, but -- furthermore, they can be converted to any integer/real types while diff --git a/translate/trans_be.adb b/translate/trans_be.adb index 80b468996..af14402eb 100644 --- a/translate/trans_be.adb +++ b/translate/trans_be.adb @@ -135,7 +135,7 @@ package body Trans_Be is pragma Unreferenced (Fi); begin case Get_Kind (Decl) is - when Iir_Kind_Design_Unit => + when Iir_Kind_Architecture_Declaration => Error_Msg_Sem ("FOREIGN architectures are not yet handled", Decl); when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => diff --git a/translate/translation.adb b/translate/translation.adb index 1284bad2e..815db0d17 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -22982,17 +22982,16 @@ package body Translation is -- binding aspect. case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => - Entity_Unit := Get_Entity (Aspect); + Entity := Get_Entity (Aspect); Arch := Get_Architecture (Aspect); if Flags.Flag_Elaborate and then Arch = Null_Iir then -- This is valid only during elaboration. - Arch := Libraries.Get_Latest_Architecture - (Get_Library_Unit (Entity_Unit)); + Arch := Libraries.Get_Latest_Architecture (Entity); end if; Config := Null_Iir; when Iir_Kind_Entity_Aspect_Configuration => - Config := Get_Library_Unit (Get_Configuration (Aspect)); - Entity_Unit := Get_Entity (Config); + Config := Get_Configuration (Aspect); + Entity := Get_Entity (Config); Arch := Get_Block_Specification (Get_Block_Configuration (Config)); when Iir_Kind_Entity_Aspect_Open => @@ -23000,7 +22999,7 @@ package body Translation is when others => Error_Kind ("translate_entity_instantiation", Aspect); end case; - Entity := Get_Library_Unit (Entity_Unit); + Entity_Unit := Get_Design_Unit (Entity); Entity_Info := Get_Info (Entity); if Config_Override /= Null_Iir then Config := Config_Override; @@ -27364,18 +27363,15 @@ package body Translation is Val := New_Rti_Address (Get_Info (Inst).Comp_Rti_Const); when Iir_Kind_Entity_Aspect_Entity => declare - Ent : Iir; + Ent : constant Iir := Get_Entity (Inst); begin - Ent := Get_Library_Unit (Get_Entity (Inst)); Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const); end; when Iir_Kind_Entity_Aspect_Configuration => declare - Config : Iir; - Ent : Iir; + Config : constant Iir := Get_Configuration (Inst); + Ent : constant Iir := Get_Entity (Config); begin - Config := Get_Library_Unit (Get_Configuration (Inst)); - Ent := Get_Library_Unit (Get_Entity (Config)); Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const); end; when others => @@ -28077,10 +28073,9 @@ package body Translation is Mark_Arch : Id_Mark_Type; Mark_Sep : Id_Mark_Type; Arch : Iir; - Entity : Iir; + Entity : constant Iir := Get_Entity (El); begin -- Note: this is done inside the architecture identifier. - Entity := Get_Library_Unit (Get_Entity (El)); Push_Identifier_Prefix (Mark_Entity, Get_Identifier (Entity)); Arch := Get_Block_Specification @@ -30134,7 +30129,7 @@ package body Translation is return; end if; Config_Lib := Get_Library_Unit (Config); - Entity := Get_Library_Unit (Get_Entity (Config_Lib)); + Entity := Get_Entity (Config_Lib); Arch := Get_Block_Specification (Get_Block_Configuration (Config_Lib)); -- cgit v1.2.3