-- Semantic analysis pass.
-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
-- GHDL is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 2, or (at your option) any later
-- version.
--
-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Unchecked_Conversion;
with Errorout; use Errorout;
with Std_Package; use Std_Package;
with Ieee.Std_Logic_1164;
with Libraries;
with Files_Map;
with Std_Names;
with Sem_Scopes; use Sem_Scopes;
with Sem_Expr; use Sem_Expr;
with Sem_Names; use Sem_Names;
with Sem_Specs; use Sem_Specs;
with Sem_Decls; use Sem_Decls;
with Sem_Assocs; use Sem_Assocs;
with Sem_Inst;
with Iirs_Utils; use Iirs_Utils;
with Flags; use Flags;
with Name_Table;
with Str_Table;
with Sem_Stmts; use Sem_Stmts;
with Iir_Chains;
with Xrefs; use Xrefs;
package body Sem is
-- Forward declarations.
procedure Sem_Context_Clauses (Unit: Iir);
procedure Sem_Block_Configuration
(Block_Conf : Iir_Block_Configuration; Father: Iir);
procedure Sem_Component_Configuration
(Conf : Iir_Component_Configuration; Father : Iir);
procedure Add_Dependence (Unit : Iir)
is
Targ : constant Iir := Get_Current_Design_Unit;
begin
-- During normal analysis, there is a current design unit. But not
-- during debugging outside of any context.
if Targ = Null_Iir then
return;
end if;
Add_Dependence (Targ, Unit);
end Add_Dependence;
-- LRM 1.1 Entity declaration.
procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration) is
begin
Xrefs.Xref_Decl (Entity);
Sem_Scopes.Add_Name (Entity);
Set_Visible_Flag (Entity, True);
Set_Is_Within_Flag (Entity, True);
-- LRM 10.1
-- 1. An entity declaration, together with a corresponding architecture
-- body.
Open_Declarative_Region;
-- Sem generics.
Sem_Interface_Chain (Get_Generic_Chain (Entity), Generic_Interface_List);
-- Sem ports.
Sem_Interface_Chain (Get_Port_Chain (Entity), Port_Interface_List);
-- Entity declarative part and concurrent statements.
Sem_Block (Entity, True);
Close_Declarative_Region;
Set_Is_Within_Flag (Entity, False);
end Sem_Entity_Declaration;
-- Get the entity unit for LIBRARY_UNIT (an architecture or a
-- configuration declaration).
-- Return NULL_IIR in case of error (not found, bad library).
function Sem_Entity_Name (Library_Unit : Iir) return Iir
is
Name : Iir;
Library : Iir_Library_Declaration;
Entity : Iir;
begin
-- Get the library of architecture/configuration.
Library := Get_Library
(Get_Design_File (Get_Design_Unit (Library_Unit)));
-- Resolve the name.
Name := Get_Entity_Name (Library_Unit);
if Get_Kind (Name) = Iir_Kind_Simple_Name then
-- LRM93 10.1 Declarative Region
-- LRM08 12.1 Declarative Region
-- a) An entity declaration, tohether with a corresponding
-- architecture body.
--
-- GHDL: simple name needs to be handled specially. Because
-- architecture body is in the declarative region of its entity,
-- the entity name is directly visible. But we cannot really use
-- that rule as is, as we don't know which is the entity.
Entity := Libraries.Load_Primary_Unit
(Library, Get_Identifier (Name), Library_Unit);
if Entity = Null_Iir then
Error_Msg_Sem ("entity " & Disp_Node (Name) & " was not analysed",
Library_Unit);
return Null_Iir;
end if;
Entity := Get_Library_Unit (Entity);
Set_Named_Entity (Name, Entity);
Xrefs.Xref_Ref (Name, Entity);
else
-- Certainly an expanded name. Use the standard name analysis.
Name := Sem_Denoting_Name (Name);
Set_Entity_Name (Library_Unit, Name);
Entity := Get_Named_Entity (Name);
end if;
if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then
Error_Class_Match (Name, "entity");
return Null_Iir;
end if;
-- 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 Sem_Entity_Name;
-- LRM 1.2 Architecture bodies.
procedure Sem_Architecture_Body (Arch: Iir_Architecture_Body)
is
Entity_Unit : Iir_Design_Unit;
Entity_Library : Iir_Entity_Declaration;
begin
Xrefs.Xref_Decl (Arch);
-- First, find the entity.
Entity_Library := Sem_Entity_Name (Arch);
if Entity_Library = Null_Iir then
return;
end if;
Entity_Unit := Get_Design_Unit (Entity_Library);
-- LRM93 11.4
-- In each case, the second unit depends on the first unit.
-- GHDL: an architecture depends on its entity.
Add_Dependence (Entity_Unit);
Add_Context_Clauses (Entity_Unit);
Set_Is_Within_Flag (Arch, True);
Set_Is_Within_Flag (Entity_Library, True);
-- Makes the entity name visible.
-- FIXME: quote LRM.
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
-- body.
Open_Declarative_Region;
Sem_Scopes.Add_Entity_Declarations (Entity_Library);
-- LRM02 1.2 Architecture bodies
-- For the purpose of interpreting the scope and visibility of the
-- identifier (see 10.2 and 10.3), the declaration of the identifier is
-- considered to occur after the final declarative item of the entity
-- declarative part of the corresponding entity declaration.
--
-- FIXME: before VHDL-02, an architecture is not a declaration.
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
-- considered to occur immediatly within the declarative region
-- associated with the entity declaration corresponding to the given
-- architecture body.
if Vhdl_Std >= Vhdl_02 then
Open_Declarative_Region;
end if;
Sem_Block (Arch, True);
if Vhdl_Std >= Vhdl_02 then
Close_Declarative_Region;
end if;
Close_Declarative_Region;
Set_Is_Within_Flag (Arch, False);
Set_Is_Within_Flag (Entity_Library, False);
end Sem_Architecture_Body;
-- Return the real resolver used for (sub) object OBJ.
-- Return NULL_IIR if none.
function Get_Resolver (Obj : Iir) return Iir
is
Obj_Type : Iir;
Res : Iir;
begin
case Get_Kind (Obj) is
when Iir_Kind_Indexed_Name
| Iir_Kind_Slice_Name
| Iir_Kind_Selected_Element =>
Res := Get_Resolver (Get_Prefix (Obj));
if Res /= Null_Iir then
return Res;
end if;
when Iir_Kind_Signal_Declaration
| Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Guard_Signal_Declaration =>
null;
when Iir_Kind_Object_Alias_Declaration =>
return Get_Resolver (Get_Name (Obj));
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
return Get_Resolver (Get_Named_Entity (Obj));
when others =>
Error_Kind ("get_resolved", Obj);
end case;
Obj_Type := Get_Type (Obj);
if Get_Kind (Obj_Type) in Iir_Kinds_Subtype_Definition then
return Get_Resolution_Indication (Obj_Type);
else
return Null_Iir;
end if;
end Get_Resolver;
-- Return TRUE iff the actual of ASSOC can be the formal.
-- ASSOC must be an association_element_by_expression.
function Can_Collapse_Signals (Assoc : Iir; Formal : Iir) return Boolean
is
Actual : Iir;
Actual_Res : Iir;
Formal_Res : Iir;
Formal_Base : Iir;
Actual_Base : Iir;
begin
-- If there is a conversion, signals types are not necessarily
-- the same, and sharing is not possible.
-- FIXME: optimize type conversions
-- (unsigned <-> signed <-> std_ulogic_vector <-> ...)
if Get_In_Conversion (Assoc) /= Null_Iir
or else Get_Out_Conversion (Assoc) /= Null_Iir
then
return False;
end if;
-- Here we may assume formal and actual have the same type and the
-- same lengths. This is caught at elaboration time.
Actual := Name_To_Object (Get_Actual (Assoc));
if Actual = Null_Iir then
-- This is an expression.
return False;
end if;
Formal_Base := Get_Object_Prefix (Formal);
Actual_Base := Get_Object_Prefix (Actual);
-- If the formal is of mode IN, then it has no driving value, and its
-- effective value is the effective value of the actual.
-- Always collapse in this case.
if Get_Mode (Formal_Base) = Iir_In_Mode then
return True;
end if;
-- Otherwise, these rules are applied:
--
-- In this table, E means element, S means signal.
-- Er means the element is resolved,
-- Sr means the signal is resolved (at the signal level).
--
-- Actual
-- | E,S | Er,S | E,Sr | Er,Sr |
-- ------+-------+-------+-------+-------+
-- E,S |collap | no(3) | no(3) | no(3) |
-- ------+-------+-------+-------+-------+
-- Er,S | no(1) |if same| no(2) | no(2) |
-- Formal ------+-------+-------+-------+-------+
-- E,Sr | no(1) | no(2) |if same| no(4) |
-- ------+-------+-------+-------+-------+
-- Er,Sr | no(1) | no(2) | no(4) |if same|
-- ------+-------+-------+-------+-------+
--
-- Notes: (1): formal may have several sources.
-- (2): resolver is not the same.
-- (3): this prevents to catch several sources error in instance.
-- (4): resolver is not the same, because the types are not the
-- same.
--
-- Furthermore, signals cannot be collapsed if the kind (none, bus or
-- register) is not the same.
--
-- Default value: default value is the effective value.
-- Resolution function.
Actual_Res := Get_Resolver (Actual);
Formal_Res := Get_Resolver (Formal);
-- If the resolutions are not the same, signals cannot be collapsed.
if Actual_Res /= Formal_Res then
return False;
end if;
-- If neither the actual nor the formal is resolved, then collapsing is
-- possible.
-- (this is case ES/ES).
if Actual_Res = Null_Iir and Formal_Res = Null_Iir then
return True;
end if;
-- If the formal can have sources and is guarded, but the actual is
-- not guarded (or has not the same kind of guard), signals cannot
-- be collapsed.
if (Get_Guarded_Signal_Flag (Formal_Base)
/= Get_Guarded_Signal_Flag (Actual_Base))
or else (Get_Signal_Kind (Formal_Base)
/= Get_Signal_Kind (Actual_Base))
then
return False;
end if;
return True;
end Can_Collapse_Signals;
-- INTER_PARENT contains generics interfaces;
-- ASSOC_PARENT constains generic aspects.
function Sem_Generic_Association_Chain
(Inter_Parent : Iir; Assoc_Parent : Iir) return Boolean
is
El : Iir;
Match : Compatibility_Level;
Assoc_Chain : Iir;
Inter_Chain : Iir;
Miss : Missing_Type;
begin
-- LRM08 6.5.6.2 Generic clauses
-- If no such actual is specified for a given formal generic constant
-- (either because the formal generic is unassociated or because the
-- actual is open), and if a default expression is specified for that
-- generic, the value of this expression is the value of the generic.
-- It is an error if no actual is specified for a given formal generic
-- constant and no default expression is present in the corresponding
-- interface element.
-- Note: CHECK_MATCH argument of sem_subprogram_arguments must be
-- true if parent is a component instantiation.
case Get_Kind (Assoc_Parent) is
when Iir_Kind_Component_Instantiation_Statement =>
-- LRM 9.6 Component Instantiation Statement
-- Each local generic (or subelement or slice thereof) must be
-- associated {VHDL87: exactly}{VHDL93: at most} once.
-- ...
-- Each local port (or subelement or slice therof) must be
-- associated {VHDL87: exactly}{VHDL93: at most} once.
-- GHDL: for a direct instantiation, follow rules of
-- LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
if Flags.Vhdl_Std = Vhdl_87
or else Get_Kind (Inter_Parent) = Iir_Kind_Entity_Declaration
then
Miss := Missing_Generic;
else
Miss := Missing_Allowed;
end if;
when Iir_Kind_Binding_Indication =>
-- LRM 5.2.1.2 Generic map and port map aspects
Miss := Missing_Allowed;
when Iir_Kind_Block_Header =>
Miss := Missing_Generic;
when Iir_Kind_Package_Instantiation_Declaration =>
-- LRM08 4.9
-- Each formal generic (or member thereof) shall be associated
-- at most once.
Miss := Missing_Generic;
when others =>
Error_Kind ("sem_generic_association_list", Assoc_Parent);
end case;
-- The generics
Inter_Chain := Get_Generic_Chain (Inter_Parent);
Assoc_Chain := Get_Generic_Map_Aspect_Chain (Assoc_Parent);
-- Extract non-object associations, as the actual cannot be analyzed
-- as an expression.
Assoc_Chain := Extract_Non_Object_Association (Assoc_Chain, Inter_Chain);
Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
return False;
end if;
Sem_Association_Chain
(Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match);
Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
if Match = Not_Compatible then
return False;
end if;
-- LRM 5.2.1.2 Generic map and port map aspects
-- An actual associated with a formal generic map aspect must be an
-- expression or the reserved word open;
El := Assoc_Chain;
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Association_Element_By_Expression =>
Check_Read (Get_Actual (El));
when Iir_Kind_Association_Element_Open
| Iir_Kind_Association_Element_By_Individual
| Iir_Kind_Association_Element_Package =>
null;
when others =>
Error_Kind ("sem_generic_map_association_chain(1)", El);
end case;
El := Get_Chain (El);
end loop;
return True;
end Sem_Generic_Association_Chain;
procedure Sem_Generic_Association_Chain
(Inter_Parent : Iir; Assoc_Parent : Iir)
is
Res : Boolean;
pragma Unreferenced (Res);
begin
Res := Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
end Sem_Generic_Association_Chain;
-- INTER_PARENT contains ports interfaces;
-- ASSOC_PARENT constains ports map aspects.
procedure Sem_Port_Association_Chain
(Inter_Parent : Iir; Assoc_Parent : Iir)
is
El : Iir;
Actual : Iir;
Prefix : Iir;
Object : Iir;
Match : Compatibility_Level;
Assoc_Chain : Iir;
Miss : Missing_Type;
Inter : Iir;
Formal : Iir;
Formal_Base : Iir;
begin
-- Note: CHECK_MATCH argument of sem_subprogram_arguments must be
-- true if parent is a component instantiation.
case Get_Kind (Assoc_Parent) is
when Iir_Kind_Component_Instantiation_Statement =>
-- LRM 9.6 Component Instantiation Statement
-- Each local generic (or subelement or slice thereof) must be
-- associated {VHDL87: exactly}{VHDL93: at most} once.
-- ...
-- Each local port (or subelement or slice therof) must be
-- associated {VHDL87: exactly}{VHDL93: at most} once.
-- GHDL: for a direct instantiation, follow rules of
-- LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
if Flags.Vhdl_Std = Vhdl_87
or else Get_Kind (Inter_Parent) = Iir_Kind_Entity_Declaration
then
Miss := Missing_Port;
else
Miss := Missing_Allowed;
end if;
when Iir_Kind_Binding_Indication =>
-- LRM 5.2.1.2 Generic map and port map aspects
Miss := Missing_Allowed;
when Iir_Kind_Block_Header =>
-- FIXME: it is possible to have port unassociated ?
Miss := Missing_Port;
when others =>
Error_Kind ("sem_port_association_list", Assoc_Parent);
end case;
-- The ports
Assoc_Chain := Get_Port_Map_Aspect_Chain (Assoc_Parent);
if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
return;
end if;
Sem_Association_Chain (Get_Port_Chain (Inter_Parent), Assoc_Chain,
True, Miss, Assoc_Parent, Match);
Set_Port_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
if Match = Not_Compatible then
return;
end if;
-- LRM 5.2.1.2 Generic map and port map aspects
-- [...]; an actual associated with a formal port in a port map aspect
-- must be a signal, an expression, or the reserved word open.
--
-- Certain restriction apply to the actual associated with a formal in
-- a port map aspect; these restrictions are described in 1.1.1.2
-- LRM93 1.1.1.2
-- The actual, if a port or signal, must be denoted by a static name.
-- The actual, if an expression, must be a globally static expression.
El := Assoc_Chain;
Inter := Get_Port_Chain (Inter_Parent);
while El /= Null_Iir loop
Formal := Get_Formal (El);
if Formal = Null_Iir then
-- No formal: use association by position.
Formal := Inter;
Formal_Base := Inter;
Inter := Get_Chain (Inter);
else
Inter := Null_Iir;
Formal_Base := Get_Association_Interface (El);
end if;
if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then
Actual := Get_Actual (El);
-- There has been an error, exit from the loop.
exit when Actual = Null_Iir;
Object := Name_To_Object (Actual);
if Object = Null_Iir then
Prefix := Actual;
else
Prefix := Get_Object_Prefix (Object);
end if;
case Get_Kind (Prefix) is
when Iir_Kind_Signal_Declaration
| Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Guard_Signal_Declaration
| Iir_Kinds_Signal_Attribute =>
-- Port or signal.
Set_Collapse_Signal_Flag
(El, Can_Collapse_Signals (El, Formal));
if Get_Name_Staticness (Object) < Globally then
Error_Msg_Sem ("actual must be a static name", Actual);
end if;
if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration
then
declare
P : Boolean;
pragma Unreferenced (P);
begin
P := Check_Port_Association_Restriction
(Formal_Base, Prefix, El);
end;
end if;
when others =>
-- Expression.
Set_Collapse_Signal_Flag (El, False);
-- If there is an IN conversion, re-integrate it into
-- the actual.
declare
In_Conv : Iir;
begin
In_Conv := Get_In_Conversion (El);
if In_Conv /= Null_Iir then
Set_In_Conversion (El, Null_Iir);
Set_Expr_Staticness
(In_Conv, Get_Expr_Staticness (Actual));
Actual := In_Conv;
Set_Actual (El, Actual);
end if;
end;
if Flags.Vhdl_Std >= Vhdl_93c then
-- LRM93 1.1.1.2 Ports
-- Moreover, the ports of a block may be associated
-- with an expression, in order to provide these ports
-- with constant driving values; such ports must be
-- of mode in.
if Get_Mode (Formal_Base) /= Iir_In_Mode then
Error_Msg_Sem ("only 'in' ports may be associated "
& "with expression", El);
end if;
-- LRM93 1.1.1.2 Ports
-- The actual, if an expression, must be a globally
-- static expression.
if Get_Expr_Staticness (Actual) < Globally then
Error_Msg_Sem
("actual expression must be globally static",
Actual);
end if;
else
Error_Msg_Sem
("cannot associate ports with expression in vhdl87",
El);
end if;
end case;
end if;
El := Get_Chain (El);
end loop;
end Sem_Port_Association_Chain;
-- INTER_PARENT contains generics and ports interfaces;
-- ASSOC_PARENT constains generics and ports map aspects.
procedure Sem_Generic_Port_Association_Chain
(Inter_Parent : Iir; Assoc_Parent : Iir)
is
Res : Boolean;
pragma Unreferenced (Res);
begin
Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
Sem_Port_Association_Chain (Inter_Parent, Assoc_Parent);
end Sem_Generic_Port_Association_Chain;
-- LRM 1.3 Configuration Declarations.
procedure Sem_Configuration_Declaration (Decl: Iir)
is
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 := Sem_Entity_Name (Decl);
if Entity = Null_Iir then
return;
end if;
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_Unit);
Sem_Scopes.Add_Name (Decl);
Set_Visible_Flag (Decl, True);
-- LRM 10.1 Declarative Region
-- 2. A configuration declaration.
Open_Declarative_Region;
-- LRM93 10.2
-- In addition to the above rules, the scope of any declaration that
-- includes the end of the declarative part of a given block (wether
-- 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_Unit);
Sem_Scopes.Add_Entity_Declarations (Entity);
Sem_Declaration_Chain (Decl);
-- GHDL: no need to check for missing subprogram bodies, since they are
-- not allowed in configuration declarations.
Sem_Block_Configuration (Get_Block_Configuration (Decl), Decl);
Close_Declarative_Region;
end Sem_Configuration_Declaration;
-- Analyze the block specification of a block statement or of a generate
-- statement. Return the corresponding block statement, generate
-- statement body, or Null_Iir in case of error.
function Sem_Block_Specification_Of_Statement
(Block_Conf : Iir_Block_Configuration; Father : Iir) return Iir
is
Block_Spec : Iir;
Block_Name : Iir;
Block_Stmts : Iir;
Prev : Iir_Block_Configuration;
Block : Iir;
Res : Iir;
Assoc : Iir;
Clause : Iir;
Gen_Spec : Iir;
begin
Block_Spec := Get_Block_Specification (Block_Conf);
case Get_Kind (Block_Spec) is
when Iir_Kind_Simple_Name =>
Block_Name := Block_Spec;
when Iir_Kind_Parenthesis_Name
| Iir_Kind_Slice_Name =>
Block_Name := Get_Prefix (Block_Spec);
when others =>
Error_Msg_Sem ("label expected", Block_Spec);
return Null_Iir;
end case;
-- Analyze the label and generate specification.
Block_Name := Sem_Denoting_Name (Block_Name);
Block := Get_Named_Entity (Block_Name);
case Get_Kind (Block) is
when Iir_Kind_Block_Statement =>
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem ("label does not denote a generate statement",
Block_Spec);
end if;
Set_Block_Specification (Block_Conf, Block_Name);
Prev := Get_Block_Block_Configuration (Block);
Res := Block;
when Iir_Kind_For_Generate_Statement =>
Res := Get_Generate_Statement_Body (Block);
Set_Named_Entity (Block_Name, Res);
Prev := Get_Generate_Block_Configuration (Res);
case Get_Kind (Block_Spec) is
when Iir_Kind_Simple_Name =>
Set_Block_Specification (Block_Conf, Block_Name);
when Iir_Kind_Parenthesis_Name =>
Block_Spec := Sem_Index_Specification
(Block_Spec,
Get_Type (Get_Parameter_Specification (Block)));
if Block_Spec /= Null_Iir then
Set_Prefix (Block_Spec, Block_Name);
Set_Block_Specification (Block_Conf, Block_Spec);
end if;
when others =>
raise Internal_Error;
end case;
when Iir_Kind_If_Generate_Statement =>
case Get_Kind (Block_Spec) is
when Iir_Kind_Simple_Name =>
-- LRM08 3.4.2 Block configuration
-- If no generate specification appears in such a block
-- configuration, then it applies to exactly one of the
-- following sets of blocks:
-- [...]
-- - The implicit block generated by the corresponding
-- generate statement, if and only if the corresponding
-- generate is an if generate statement and if the first
-- condition after IF evaluates to TRUE.
Res := Get_Generate_Statement_Body (Block);
-- LRM08 3.4.2 Block configuration
-- If the block specification of a block configuration
-- contains a generate statement label that denotes an if
-- generate statement, and if the first condition after IF
-- has an alternative label, then it is an error if the
-- generate statement label does not contain a generate
-- specification that is an alternative label.
if Get_Has_Label (Res) then
Error_Msg_Sem
("alternative label required in block specification",
Block_Spec);
end if;
Set_Block_Specification (Block_Conf, Block_Name);
when Iir_Kind_Parenthesis_Name =>
if Vhdl_Std < Vhdl_08 then
Error_Msg_Sem ("alternative label only allowed by vhdl08",
Block_Spec);
return Null_Iir;
end if;
Assoc := Get_Association_Chain (Block_Spec);
pragma Assert
(Get_Kind (Assoc)
= Iir_Kind_Association_Element_By_Expression);
Gen_Spec := Get_Actual (Assoc);
if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem
("alternative label expected for if-generate",
Gen_Spec);
return Null_Iir;
end if;
-- Search label.
Clause := Block;
while Clause /= Null_Iir loop
Res := Get_Generate_Statement_Body (Clause);
exit when Get_Alternative_Label (Res)
= Get_Identifier (Gen_Spec);
Clause := Get_Generate_Else_Clause (Clause);
end loop;
if Clause = Null_Iir then
Error_Msg_Sem
("alternative label " & Image_Identifier (Gen_Spec)
& " not found for if-generate", Gen_Spec);
return Null_Iir;
end if;
Set_Named_Entity (Block_Spec, Res);
Xref_Ref (Gen_Spec, Res);
Set_Prefix (Block_Spec, Block_Name);
Set_Block_Specification (Block_Conf, Block_Spec);
when others =>
raise Internal_Error;
end case;
Set_Named_Entity (Block_Name, Res);
Prev := Get_Generate_Block_Configuration (Res);
when others =>
Error_Msg_Sem ("block statement label expected", Block_Conf);
return Null_Iir;
end case;
-- LRM93 1.3.1 / LRM08 3.4.2 Block configuration
-- [...], and the label must denote a block statement or generate
-- statement that is contained immediatly within the block denoted by
-- the block specification of the containing block configuration.
Block_Stmts := Get_Concurrent_Statement_Chain
(Get_Block_From_Block_Specification
(Get_Block_Specification (Father)));
if not Is_In_Chain (Block_Stmts, Block) then
Error_Msg_Sem ("label does not denotes an inner block statement",
Block_Conf);
return Null_Iir;
end if;
case Get_Kind (Block) is
when Iir_Kind_Block_Statement =>
-- LRM93 1.3
-- It is an error if, in a given block configuration, more than
-- one configuration item is defined for the same block [or
-- component instance].
if Prev /= Null_Iir then
Error_Msg_Sem (Disp_Node (Block) & " was already configured at "
& Disp_Location (Prev), Block_Conf);
return Null_Iir;
end if;
Set_Block_Block_Configuration (Res, Block_Conf);
when Iir_Kind_If_Generate_Statement =>
-- LRM93 1.3
-- It is an error if, in a given block configuration, more than
-- one configuration item is defined for the same block [or
-- component instance].
if Prev /= Null_Iir then
Error_Msg_Sem (Disp_Node (Block) & " was already configured at "
& Disp_Location (Prev), Block_Conf);
return Null_Iir;
end if;
Set_Generate_Block_Configuration (Res, Block_Conf);
when Iir_Kind_For_Generate_Statement =>
-- LRM93 1.3
-- For any name that is the label of a generate statement
-- immediately wihin a given block, one or more corresponding
-- block configuration may appear as configuration items
-- immediately within a block configuration corresponding to the
-- given block.
-- GHDL: keep them in a linked list, but don't try to detect
-- duplicate as values may not be static. FIXME: try for
-- static values only ?
Set_Prev_Block_Configuration (Block_Conf, Prev);
Set_Generate_Block_Configuration (Res, Block_Conf);
when others =>
raise Internal_Error;
end case;
return Res;
end Sem_Block_Specification_Of_Statement;
-- LRM 1.3.1 Block Configuration.
-- FATHER is the block_configuration, configuration_declaration,
-- component_configuration containing the block_configuration BLOCK_CONF.
procedure Sem_Block_Configuration
(Block_Conf : Iir_Block_Configuration; Father: Iir)
is
El : Iir;
Block : Iir;
begin
case Get_Kind (Father) is
when Iir_Kind_Configuration_Declaration =>
-- LRM93 1.3.1
-- If a block configuration appears immediately within a
-- configuration declaration, then the block specification of that
-- block configuration must be an architecture name, and that
-- architecture name must denote a design entity body whose
-- interface is defined by the entity declaration denoted by the
-- entity name of the enclosing configuration declaration.
declare
Block_Spec : Iir;
Arch : Iir_Architecture_Body;
Design: Iir_Design_Unit;
begin
Block_Spec := Get_Block_Specification (Block_Conf);
-- FIXME: handle selected name.
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem ("architecture name expected", Block_Spec);
return;
end if;
-- LRM 10.3 rule b)
-- For an architecture body associated with a given entity
-- declaration: at the place of the block specification in a
-- block configuration for an external block whose interface
-- is defined by that entity declaration.
Design := Libraries.Load_Secondary_Unit
(Get_Design_Unit (Get_Entity (Father)),
Get_Identifier (Block_Spec),
Block_Conf);
if Design = Null_Iir then
Error_Msg_Sem
("no architecture '" & Image_Identifier (Block_Spec) & "'",
Block_Conf);
return;
end if;
Arch := Get_Library_Unit (Design);
Set_Named_Entity (Block_Spec, Arch);
Xref_Ref (Block_Spec, Arch);
Block := Arch;
Add_Dependence (Design);
end;
when Iir_Kind_Component_Configuration =>
-- LRM93 1.3.1
-- If a block configuration appears immediately within a component
-- configuration, then the corresponding components must be
-- fully bound, the block specification of that block
-- configuration must be an architecture name, and that
-- architecture name must denote the same architecture body as
-- that to which the corresponding components are bound.
declare
Block_Spec : Iir;
Arch : Iir_Architecture_Body;
Design: Iir_Design_Unit;
Entity_Aspect : Iir;
Entity : Iir;
Comp_Arch : Iir;
begin
Entity_Aspect :=
Get_Entity_Aspect (Get_Binding_Indication (Father));
if Entity_Aspect = Null_Iir or else
Get_Kind (Entity_Aspect) /= Iir_Kind_Entity_Aspect_Entity
then
Error_Msg_Sem ("corresponding component not fully bound",
Block_Conf);
end if;
Block_Spec := Get_Block_Specification (Block_Conf);
-- FIXME: handle selected name.
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem ("architecture name expected", Block_Spec);
return;
end if;
Comp_Arch := Get_Architecture (Entity_Aspect);
if Comp_Arch /= Null_Iir then
if Get_Kind (Comp_Arch) /= Iir_Kind_Simple_Name then
raise Internal_Error;
end if;
if Get_Identifier (Comp_Arch) /= Get_Identifier (Block_Spec)
then
Error_Msg_Sem
("block specification name is different from "
& "component architecture name", Block_Spec);
return;
end if;
end if;
Entity := Get_Entity (Entity_Aspect);
if Entity = Null_Iir then
return;
end if;
Design := Libraries.Load_Secondary_Unit
(Get_Design_Unit (Entity),
Get_Identifier (Block_Spec),
Block_Conf);
if Design = Null_Iir then
Error_Msg_Sem
("no architecture '" & Image_Identifier (Block_Spec) & "'",
Block_Conf);
return;
end if;
Arch := Get_Library_Unit (Design);
Set_Named_Entity (Block_Spec, Arch);
Xref_Ref (Block_Spec, Arch);
Block := Arch;
end;
when Iir_Kind_Block_Configuration =>
-- LRM93 1.3.1 / LRM08 3.4.2 Block configuration
-- If a block configuration appears immediately within another
-- block configuration, then the block specification of the
-- contained block configuration must be a block statement or
-- generate statement label, and the label must denote a block
-- statement or generate statement that is contained immediatly
-- within the block denoted by the block specification of the
-- containing block configuration.
Block := Sem_Block_Specification_Of_Statement (Block_Conf, Father);
if Block = Null_Iir then
return;
end if;
when others =>
Error_Kind ("sem_block_configuration", Father);
end case;
-- LRM93 �10.1
-- 10. A block configuration
Sem_Scopes.Open_Scope_Extension;
-- LRM 10.3
-- In addition, any declaration that is directly visible at the end of
-- the declarative part of a given block is directly visible in a block
-- configuration that configure the given block. This rule holds unless
-- a use clause that makes a homograph of the declaration potentially
-- visible (see 10.4) appears in the corresponding configuration
-- declaration, and if the scope of that use clause encompasses all or
-- part of those configuration items. If such a use clase appears, then
-- the declaration will be directly visible within the corresponding
-- configuration items, except at hose places that fall within the scope
-- of the additional use clause. At such places, neither name will be
-- directly visible.
-- FIXME: handle use clauses.
Sem_Scopes.Extend_Scope_Of_Block_Declarations (Block);
declare
El : Iir;
begin
El := Get_Declaration_Chain (Block_Conf);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Use_Clause =>
Sem_Use_Clause (El);
when others =>
-- Parse checks there are only use clauses.
raise Internal_Error;
end case;
El := Get_Chain (El);
end loop;
end;
-- VHDL 87: do not remove configuration specification in generate stmts.
Clear_Instantiation_Configuration (Block, False);
El := Get_Configuration_Item_Chain (Block_Conf);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Block_Configuration =>
Sem_Block_Configuration (El, Block_Conf);
when Iir_Kind_Component_Configuration =>
Sem_Component_Configuration (El, Block_Conf);
when others =>
Error_Kind ("sem_block_configuration(2)", El);
end case;
El := Get_Chain (El);
end loop;
Sem_Scopes.Close_Scope_Extension;
end Sem_Block_Configuration;
-- LRM 1.3.2
procedure Sem_Component_Configuration
(Conf : Iir_Component_Configuration; Father : Iir)
is
Block : Iir;
Configured_Block : Iir;
Binding : Iir;
Entity : Iir_Design_Unit;
Comp : Iir_Component_Declaration;
Primary_Entity_Aspect : Iir;
begin
-- LRM 10.1 Declarative Region
-- 11. A component configuration.
Open_Declarative_Region;
-- LRM93 �10.2
-- If a component configuration appears as a configuration item
-- immediatly within a block configuration that configures a given
-- block, and the scope of a given declaration includes the end of the
-- declarative part of that block, then the scope of the given
-- declaration extends from the beginning to the end of the
-- declarative region associated with the given component configuration.
-- GHDL: this is for labels of component instantiation statements, and
-- for local ports and generics of the component.
if Get_Kind (Father) = Iir_Kind_Block_Configuration then
Configured_Block := Get_Block_Specification (Father);
if Get_Kind (Configured_Block) = Iir_Kind_Design_Unit then
raise Internal_Error;
end if;
Configured_Block :=
Get_Block_From_Block_Specification (Configured_Block);
Sem_Scopes.Extend_Scope_Of_Block_Declarations (Configured_Block);
else
-- Can a component configuration not be just inside a block
-- configuration ?
raise Internal_Error;
end if;
-- FIXME: this is wrong (all declarations should be considered).
Sem_Component_Specification
(Configured_Block, Conf, Primary_Entity_Aspect);
Comp := Get_Named_Entity (Get_Component_Name (Conf));
if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
-- There has been an error in sem_component_specification.
-- Leave here.
Close_Declarative_Region;
return;
end if;
-- FIXME: (todo)
-- If a given component instance is unbound in the corresponding block,
-- then any explicit component configuration for that instance that does
-- not contain an explicit binding indication will contain an implicit,
-- default binding indication (see 5.2.2). Similarly, if a given
-- component instance is unbound in the corresponding block, then any
-- implicit component configuration for that instance will contain an
-- implicit, default binding indication.
Open_Declarative_Region;
Sem_Scopes.Add_Component_Declarations (Comp);
Binding := Get_Binding_Indication (Conf);
if Binding /= Null_Iir then
Sem_Binding_Indication (Binding, Comp, Conf, Primary_Entity_Aspect);
if Primary_Entity_Aspect /= Null_Iir then
-- LRM93 5.2.1 Binding Indication
-- It is an error if a formal port appears in the port map aspect
-- of the incremental binding indication and it is a formal
-- port that is associated with an actual other than OPEN in one
-- of the primary binding indications.
declare
Inst : Iir;
Primary_Binding : Iir;
F_Chain : Iir;
F_El, S_El : Iir;
Formal : Iir;
begin
Inst := Get_Concurrent_Statement_Chain (Configured_Block);
while Inst /= Null_Iir loop
if Get_Kind (Inst)
= Iir_Kind_Component_Instantiation_Statement
and then Get_Component_Configuration (Inst) = Conf
then
-- Check here.
Primary_Binding := Get_Binding_Indication
(Get_Configuration_Specification (Inst));
F_Chain := Get_Port_Map_Aspect_Chain (Primary_Binding);
S_El := Get_Port_Map_Aspect_Chain (Binding);
while S_El /= Null_Iir loop
-- Find S_EL formal in F_CHAIN.
Formal := Get_Association_Interface (S_El);
F_El := F_Chain;
while F_El /= Null_Iir loop
exit when Get_Association_Interface (F_El) = Formal;
F_El := Get_Chain (F_El);
end loop;
if F_El /= Null_Iir
and then Get_Kind (F_El)
/= Iir_Kind_Association_Element_Open
then
Error_Msg_Sem
(Disp_Node (Formal)
& " already associated in primary binding",
S_El);
end if;
S_El := Get_Chain (S_El);
end loop;
end if;
Inst := Get_Chain (Inst);
end loop;
end;
end if;
elsif Primary_Entity_Aspect = Null_Iir then
-- LRM93 5.2.1
-- If the generic map aspect or port map aspect of a primary binding
-- indication is not present, then the default rules as described
-- in 5.2.2 apply.
-- Create a default binding indication.
Entity := Get_Visible_Entity_Declaration (Comp);
Binding := Sem_Create_Default_Binding_Indication
(Comp, Entity, Conf, False);
if Binding /= Null_Iir then
-- Remap to defaults.
Set_Default_Entity_Aspect (Binding, Get_Entity_Aspect (Binding));
Set_Entity_Aspect (Binding, Null_Iir);
Set_Default_Generic_Map_Aspect_Chain
(Binding, Get_Generic_Map_Aspect_Chain (Binding));
Set_Generic_Map_Aspect_Chain (Binding, Null_Iir);
Set_Default_Port_Map_Aspect_Chain
(Binding, Get_Port_Map_Aspect_Chain (Binding));
Set_Port_Map_Aspect_Chain (Binding, Null_Iir);
Set_Binding_Indication (Conf, Binding);
end if;
end if;
Close_Declarative_Region;
-- External block.
Block := Get_Block_Configuration (Conf);
if Block /= Null_Iir and then Binding /= Null_Iir then
Sem_Block_Configuration (Block, Conf);
end if;
Close_Declarative_Region;
end Sem_Component_Configuration;
function Are_Trees_Chain_Equal (Left, Right : Iir) return Boolean
is
El_Left, El_Right : Iir;
begin
if Left = Right then
return True;
end if;
El_Left := Left;
El_Right := Right;
loop
if El_Left = Null_Iir and El_Right = Null_Iir then
return True;
end if;
if El_Left = Null_Iir or El_Right = Null_Iir then
return False;
end if;
if not Are_Trees_Equal (El_Left, El_Right) then
return False;
end if;
El_Left := Get_Chain (El_Left);
El_Right := Get_Chain (El_Right);
end loop;
end Are_Trees_Chain_Equal;
-- Return TRUE iff LEFT and RIGHT are (in depth) equal.
-- This corresponds to conformance rules, LRM93 2.7
function Are_Trees_Equal (Left, Right : Iir) return Boolean
is
El_Left, El_Right : Iir;
begin
-- Short-cut to speed up.
if Left = Right then
return True;
end if;
-- Handle null_iir.
if Left = Null_Iir or Right = Null_Iir then
-- Note: LEFT *xor* RIGHT is null_iir.
return False;
end if;
-- LRM 2.7 Conformance Rules
-- A simple name can be replaced by an expanded name in which this
-- simple name is the selector, if and only if at both places the
-- meaning of the simple name is given by the same declaration.
case Get_Kind (Left) is
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
case Get_Kind (Right) is
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
return Are_Trees_Equal (Get_Named_Entity (Left),
Get_Named_Entity (Right));
when others =>
return False;
end case;
when others =>
null;
end case;
-- If nodes are not of the same kind, then they are not equals!
if Get_Kind (Left) /= Get_Kind (Right) then
return False;
end if;
case Get_Kind (Left) is
when Iir_Kind_Procedure_Declaration =>
return Are_Trees_Chain_Equal
(Get_Interface_Declaration_Chain (Left),
Get_Interface_Declaration_Chain (Right));
when Iir_Kind_Function_Declaration =>
if not Are_Trees_Equal (Get_Return_Type (Left),
Get_Return_Type (Right))
then
return False;
end if;
if Get_Pure_Flag (Left) /= Get_Pure_Flag (Right) then
return False;
end if;
if not Are_Trees_Chain_Equal
(Get_Interface_Declaration_Chain (Left),
Get_Interface_Declaration_Chain (Right))
then
return False;
end if;
return True;
when Iir_Kind_Interface_Constant_Declaration
| Iir_Kind_Interface_Variable_Declaration
| Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Interface_File_Declaration =>
if Get_Identifier (Left) /= Get_Identifier (Right) then
return False;
end if;
if Get_Has_Mode (Left) /= Get_Has_Mode (Right)
or else Get_Has_Class (Left) /= Get_Has_Class (Right)
or else (Get_Has_Identifier_List (Left)
/= Get_Has_Identifier_List (Right))
or else Get_Mode (Left) /= Get_Mode (Right)
then
return False;
end if;
if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then
return False;
end if;
El_Left := Get_Default_Value (Left);
El_Right := Get_Default_Value (Right);
if (El_Left = Null_Iir) xor (El_Right = Null_Iir) then
return False;
end if;
if El_Left /= Null_Iir
and then Are_Trees_Equal (El_Left, El_Right) = False
then
return False;
end if;
return True;
when Iir_Kind_Integer_Subtype_Definition
| Iir_Kind_Enumeration_Subtype_Definition
| Iir_Kind_Floating_Subtype_Definition
| Iir_Kind_Physical_Subtype_Definition =>
if Get_Base_Type (Left) /= Get_Base_Type (Right) then
return False;
end if;
if Get_Type_Declarator (Left) /= Get_Type_Declarator (Right) then
return False;
end if;
if not Are_Trees_Equal (Get_Resolution_Indication (Left),
Get_Resolution_Indication (Right))
then
return False;
end if;
if Are_Trees_Equal (Get_Range_Constraint (Left),
Get_Range_Constraint (Right)) = False
then
return False;
end if;
return True;
when Iir_Kind_Array_Subtype_Definition =>
if Get_Base_Type (Left) /= Get_Base_Type (Right) then
return False;
end if;
if not Are_Trees_Equal (Get_Resolution_Indication (Left),
Get_Resolution_Indication (Right))
then
return False;
end if;
declare
L_Left, L_Right : Iir_List;
begin
L_Left := Get_Index_Subtype_List (Left);
L_Right := Get_Index_Subtype_List (Right);
for I in Natural loop
El_Left := Get_Nth_Element (L_Left, I);
El_Right := Get_Nth_Element (L_Right, I);
exit when El_Left = Null_Iir;
if not Are_Trees_Equal (El_Left, El_Right) then
return False;
end if;
end loop;
end;
return True;
when Iir_Kind_Record_Subtype_Definition =>
if Get_Base_Type (Left) /= Get_Base_Type (Right) then
return False;
end if;
if not Are_Trees_Equal (Get_Resolution_Indication (Left),
Get_Resolution_Indication (Right))
then
return False;
end if;
declare
L_Left, L_Right : Iir_List;
begin
L_Left := Get_Elements_Declaration_List (Left);
L_Right := Get_Elements_Declaration_List (Right);
for I in Natural loop
El_Left := Get_Nth_Element (L_Left, I);
El_Right := Get_Nth_Element (L_Right, I);
exit when El_Left = Null_Iir;
if not Are_Trees_Equal (El_Left, El_Right) then
return False;
end if;
end loop;
end;
return True;
when Iir_Kind_Integer_Literal =>
if Get_Value (Left) /= Get_Value (Right) then
return False;
end if;
return Are_Trees_Equal (Get_Literal_Origin (Left),
Get_Literal_Origin (Right));
when Iir_Kind_Enumeration_Literal =>
if Get_Enum_Pos (Left) /= Get_Enum_Pos (Right) then
return False;
end if;
return Are_Trees_Equal (Get_Literal_Origin (Left),
Get_Literal_Origin (Right));
when Iir_Kind_Physical_Int_Literal =>
if Get_Value (Left) /= Get_Value (Right)
or else not Are_Trees_Equal (Get_Unit_Name (Left),
Get_Unit_Name (Right))
then
return False;
end if;
return Are_Trees_Equal (Get_Literal_Origin (Left),
Get_Literal_Origin (Right));
when Iir_Kind_Physical_Fp_Literal =>
if Get_Fp_Value (Left) /= Get_Fp_Value (Right)
or else Get_Unit_Name (Left) /= Get_Unit_Name (Right)
then
return False;
end if;
return Are_Trees_Equal (Get_Literal_Origin (Left),
Get_Literal_Origin (Right));
when Iir_Kind_Floating_Point_Literal =>
if Get_Fp_Value (Left) /= Get_Fp_Value (Right) then
return False;
end if;
return Are_Trees_Equal (Get_Literal_Origin (Left),
Get_Literal_Origin (Right));
when Iir_Kinds_Dyadic_Operator =>
return Are_Trees_Equal (Get_Left (Left), Get_Left (Right))
and then Are_Trees_Equal (Get_Right (Left), Get_Right (Right));
when Iir_Kinds_Monadic_Operator =>
return Are_Trees_Equal (Get_Operand (Left), Get_Operand (Right));
when Iir_Kind_Access_Type_Definition
| Iir_Kind_Record_Type_Definition
| Iir_Kind_Array_Type_Definition
| Iir_Kind_Enumeration_Type_Definition
| Iir_Kind_File_Type_Definition =>
return Left = Right;
when Iir_Kind_Range_Expression =>
if Get_Type (Left) /= Get_Type (Right)
or else Get_Direction (Left) /= Get_Direction (Right)
then
return False;
end if;
if not Are_Trees_Equal (Get_Left_Limit (Left),
Get_Left_Limit (Right))
or else not Are_Trees_Equal (Get_Right_Limit (Left),
Get_Right_Limit (Right))
then
return False;
end if;
return True;
when Iir_Kind_High_Type_Attribute
| Iir_Kind_Low_Type_Attribute
| Iir_Kind_Left_Type_Attribute
| Iir_Kind_Right_Type_Attribute
| Iir_Kind_Ascending_Type_Attribute =>
return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right));
when Iir_Kind_String_Literal8 =>
if Get_Bit_String_Base (Left) /= Get_Bit_String_Base (Right) then
return False;
end if;
declare
use Str_Table;
Len : constant Nat32 := Get_String_Length (Left);
L_Id : constant String8_Id := Get_String8_Id (Left);
R_Id : constant String8_Id := Get_String8_Id (Right);
begin
if Get_String_Length (Right) /= Len then
return False;
end if;
for I in 1 .. Len loop
if Element_String8 (L_Id, I) /= Element_String8 (R_Id, I)
then
return False;
end if;
end loop;
return True;
end;
when Iir_Kind_Aggregate =>
if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then
return False;
end if;
declare
El_L, El_R : Iir;
begin
El_L := Get_Association_Choices_Chain (Left);
El_R := Get_Association_Choices_Chain (Right);
loop
exit when El_L = Null_Iir and El_R = Null_Iir;
if not Are_Trees_Equal (El_L, El_R) then
return False;
end if;
El_L := Get_Chain (El_L);
El_R := Get_Chain (El_R);
end loop;
return True;
end;
when Iir_Kind_Choice_By_None
| Iir_Kind_Choice_By_Others =>
return Are_Trees_Equal (Get_Associated_Expr (Left),
Get_Associated_Expr (Right));
when Iir_Kind_Choice_By_Name =>
if not Are_Trees_Equal (Get_Choice_Name (Left),
Get_Choice_Name (Right))
then
return False;
end if;
return Are_Trees_Equal (Get_Associated_Expr (Left),
Get_Associated_Expr (Right));
when Iir_Kind_Choice_By_Expression =>
if not Are_Trees_Equal (Get_Choice_Expression (Left),
Get_Choice_Expression (Right)) then
return False;
end if;
return Are_Trees_Equal (Get_Associated_Expr (Left),
Get_Associated_Expr (Right));
when Iir_Kind_Choice_By_Range =>
if not Are_Trees_Equal (Get_Choice_Range (Left),
Get_Choice_Range (Right)) then
return False;
end if;
return Are_Trees_Equal (Get_Associated_Expr (Left),
Get_Associated_Expr (Right));
when Iir_Kind_Character_Literal =>
return Are_Trees_Equal (Get_Named_Entity (Left),
Get_Named_Entity (Right));
when Iir_Kind_Allocator_By_Subtype =>
return Are_Trees_Equal (Get_Subtype_Indication (Left),
Get_Subtype_Indication (Right));
when Iir_Kind_Allocator_By_Expression =>
return Are_Trees_Equal (Get_Expression (Left),
Get_Expression (Right));
when others =>
Error_Kind ("are_trees_equal", Left);
end case;
end Are_Trees_Equal;
-- LRM 2.7 Conformance Rules.
procedure Check_Conformance_Rules (Subprg, Spec: Iir) is
begin
if not Are_Trees_Equal (Subprg, Spec) then
-- FIXME: should explain why it does not conform ?
Error_Msg_Sem ("body of " & Disp_Node (Subprg)
& " does not conform with specification at "
& Disp_Location (Spec), Subprg);
end if;
end Check_Conformance_Rules;
-- Return the specification corresponding to a declaration DECL, or
-- null_Iir if none.
-- FIXME: respect rules of LRM93 2.7
function Find_Subprogram_Specification (Decl: Iir) return Iir
is
Interpretation : Name_Interpretation_Type;
Decl1: Iir;
Hash : Iir_Int32;
begin
Hash := Get_Subprogram_Hash (Decl);
Interpretation := Get_Interpretation (Get_Identifier (Decl));
while Valid_Interpretation (Interpretation) loop
if not Is_In_Current_Declarative_Region (Interpretation) then
-- The declaration does not belong to the current declarative
-- region, neither will the following one. So, we do not found
-- it.
return Null_Iir;
end if;
Decl1 := Get_Declaration (Interpretation);
-- Should be sure DECL1 and DECL belongs to the same declarative
-- region, ie DECL1 was not made visible via a USE clause.
--
-- Also, only check for explicitly subprograms (and not
-- implicit one).
if not Is_Implicit_Subprogram (Decl1)
and then Get_Kind (Decl1) in Iir_Kinds_Subprogram_Declaration
and then not Is_Potentially_Visible (Interpretation)
and then Get_Subprogram_Hash (Decl1) = Hash
and then Is_Same_Profile (Decl, Decl1)
then
return Decl1;
end if;
Interpretation := Get_Next_Interpretation (Interpretation);
end loop;
return Null_Iir;
end Find_Subprogram_Specification;
procedure Set_Subprogram_Overload_Number (Decl : Iir)
is
Id : constant Name_Id := Get_Identifier (Decl);
Inter : Name_Interpretation_Type;
Prev : Iir;
Num : Iir_Int32;
begin
Inter := Get_Interpretation (Id);
while Valid_Interpretation (Inter)
and then Is_In_Current_Declarative_Region (Inter)
loop
-- There is a previous declaration with the same name in the
-- current declarative region.
Prev := Get_Declaration (Inter);
case Get_Kind (Prev) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
if Is_Implicit_Subprogram (Prev) then
-- Implicit declarations aren't taken into account (as they
-- are mangled differently).
Inter := Get_Next_Interpretation (Inter);
else
-- The previous declaration is a user subprogram.
Num := Get_Overload_Number (Prev) + 1;
if Num = 1
and then Get_Parent (Prev) = Get_Parent (Decl)
then
-- The previous was not (yet) overloaded. Mark it as
-- overloaded.
-- Do not mark it if it is not in the same declarative
-- part (ie, do not change a subprogram declaration in
-- the package while analyzing the body).
Set_Overload_Number (Prev, 1);
Num := 2;
end if;
Set_Overload_Number (Decl, Num);
return;
end if;
when Iir_Kind_Enumeration_Literal =>
-- Enumeration literal are ignored for overload number.
Inter := Get_Next_Interpretation (Inter);
when Iir_Kind_Non_Object_Alias_Declaration =>
-- Subprogram aliases aren't considered, just skip them.
-- (No subprogram is created by an alias).
Inter := Get_Next_Interpretation (Inter);
when others =>
-- Case of user error: redefinition of an identifier.
-- Error message is generated by sem_scope.
Set_Overload_Number (Decl, 0);
return;
end case;
end loop;
-- No previous declaration in the current declarative region.
Set_Overload_Number (Decl, 0);
end Set_Subprogram_Overload_Number;
-- Check requirements on number of interfaces for subprogram specification
-- SUBPRG. Requirements only concern operators, and are defined in
-- LRM 2.3.1
procedure Check_Operator_Requirements (Id : Name_Id; Subprg : Iir)
is
use Std_Names;
Nbr_Interfaces : Natural;
Is_Method : Boolean;
begin
Nbr_Interfaces := Iir_Chains.Get_Chain_Length
(Get_Interface_Declaration_Chain (Subprg));
-- For vhdl-02, the protected variable is an implicit parameter.
if Flags.Vhdl_Std >= Vhdl_02
and then Is_Subprogram_Method (Subprg)
then
Nbr_Interfaces := Nbr_Interfaces + 1;
else
Is_Method := False;
end if;
case Id is
when Name_Abs
| Name_Not =>
-- LRM93 2.3.1
-- The subprogram specification of a unary operator must have a
-- single parameter.
-- LRM02 2.3.1
-- ..., unless the subprogram specification is a method (see
-- 3.5.1) of a protected type. In this latter case, the
-- subprogram specification must have no parameters.
if Nbr_Interfaces = 1 then
return;
end if;
Error_Msg_Sem ("unary operator must have a single parameter",
Subprg);
when Name_Mod
| Name_Rem
| Name_Op_Mul
| Name_Op_Div
| Name_Relational_Operators
| Name_Op_Concatenation
| Name_Shift_Operators
| Name_Op_Exp =>
-- LRM93 2.3.1
-- The subprogram specification of a binary operator must have
-- two parameters.
-- LRM02 2.3.1
-- ..., unless the subprogram specification is a method of a
-- protected type, in which case, the subprogram specification
-- must have a single parameter.
if Nbr_Interfaces = 2 then
return;
end if;
Error_Msg_Sem
("binary operators must have two parameters", Subprg);
when Name_Logical_Operators
| Name_Xnor =>
-- LRM08 4.5.2 Operator overloading
-- For each of the "+", "-", "and", "or", "xor", "nand", "nor"
-- and "xnor", overloading is allowed both as a unary operator
-- and as a binary operator.
if Nbr_Interfaces = 2 then
return;
end if;
if Nbr_Interfaces = 1 then
if Vhdl_Std >= Vhdl_08 then
return;
end if;
Error_Msg_Sem
("logical operators must have two parameters before vhdl08",
Subprg);
else
Error_Msg_Sem
("logical operators must have two parameters", Subprg);
end if;
when Name_Op_Plus
| Name_Op_Minus =>
-- LRM93 2.3.1
-- For each of the operators "+" and "-", overloading is allowed
-- both as a unary operator and as a binary operator.
if Nbr_Interfaces in 1 .. 2 then
return;
end if;
Error_Msg_Sem
("""+"" and ""-"" operators must have 1 or 2 parameters",
Subprg);
when others =>
return;
end case;
if Is_Method then
Error_Msg_Sem
(" (the protected object is an implicit parameter of methods)",
Subprg);
end if;
end Check_Operator_Requirements;
procedure Compute_Subprogram_Hash (Subprg : Iir)
is
type Hash_Type is mod 2**32;
function To_Hash is new Ada.Unchecked_Conversion
(Source => Iir, Target => Hash_Type);
function To_Int32 is new Ada.Unchecked_Conversion
(Source => Hash_Type, Target => Iir_Int32);
Kind : Iir_Kind;
Hash : Hash_Type;
Sig : Hash_Type;
Inter : Iir;
Itype : Iir;
begin
Kind := Get_Kind (Subprg);
if Kind = Iir_Kind_Function_Declaration
or else Kind = Iir_Kind_Enumeration_Literal
then
Itype := Get_Base_Type (Get_Return_Type (Subprg));
Hash := To_Hash (Itype);
Sig := 8;
else
Sig := 1;
Hash := 0;
end if;
if Kind /= Iir_Kind_Enumeration_Literal then
Inter := Get_Interface_Declaration_Chain (Subprg);
while Inter /= Null_Iir loop
Itype := Get_Base_Type (Get_Type (Inter));
Sig := Sig + 1;
Hash := Hash * 7 + To_Hash (Itype);
Hash := Hash + Hash / 2**28;
Inter := Get_Chain (Inter);
end loop;
end if;
Set_Subprogram_Hash (Subprg, To_Int32 (Hash + Sig));
end Compute_Subprogram_Hash;
-- LRM 2.1 Subprogram Declarations.
procedure Sem_Subprogram_Declaration (Subprg: Iir)
is
Parent : constant Iir := Get_Parent (Subprg);
Spec: Iir;
Interface_Chain : Iir;
Subprg_Body : Iir;
Return_Type : Iir;
begin
-- Set depth.
case Get_Kind (Parent) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
raise Internal_Error;
when Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body =>
Set_Subprogram_Depth
(Subprg,
Get_Subprogram_Depth
(Get_Subprogram_Specification (Parent)) + 1);
when others =>
-- FIXME: protected type ?
Set_Subprogram_Depth (Subprg, 0);
end case;
-- LRM 10.1 Declarative Region
-- 3. A subprogram declaration, together with the corresponding
-- subprogram body.
Open_Declarative_Region;
-- Sem interfaces.
Interface_Chain := Get_Interface_Declaration_Chain (Subprg);
case Get_Kind (Subprg) is
when Iir_Kind_Function_Declaration =>
Sem_Interface_Chain
(Interface_Chain, Function_Parameter_Interface_List);
Return_Type := Get_Return_Type_Mark (Subprg);
Return_Type := Sem_Type_Mark (Return_Type);
Set_Return_Type_Mark (Subprg, Return_Type);
Return_Type := Get_Type (Return_Type);
Set_Return_Type (Subprg, Return_Type);
Set_All_Sensitized_State (Subprg, Unknown);
-- LRM08 4.2 Subprogram declarations
-- It is an error if the result subtype of a function denotes
-- either a file type or a protected type. Moreover, it is an
-- error if the result subtype of a pure function denotes an
-- access type or a subtype that has a subelement of an access
-- type.
-- GHDL: this was added by VHDL 2008, but vital packages don't
-- follow that rule. So, it is not retroactive.
case Get_Kind (Return_Type) is
when Iir_Kind_File_Type_Definition =>
Error_Msg_Sem
("result subtype cannot denote a file type", Subprg);
when Iir_Kind_Protected_Type_Declaration =>
Error_Msg_Sem
("result subtype cannot denote a protected type", Subprg);
when Iir_Kind_Access_Type_Definition
| Iir_Kind_Access_Subtype_Definition =>
if Vhdl_Std >= Vhdl_08
and then Get_Pure_Flag (Subprg)
then
Error_Msg_Sem_Relaxed
("result subtype of a pure function cannot denote an"
& " access type", Subprg);
end if;
when others =>
if Vhdl_Std >= Vhdl_08
and then not Get_Signal_Type_Flag (Return_Type)
and then Get_Pure_Flag (Subprg)
then
Error_Msg_Sem_Relaxed
("result subtype of a pure function cannot have"
& " access subelements", Subprg);
end if;
end case;
when Iir_Kind_Procedure_Declaration =>
Sem_Interface_Chain
(Interface_Chain, Procedure_Parameter_Interface_List);
-- Unless the body is analyzed, the procedure purity is unknown.
Set_Purity_State (Subprg, Unknown);
-- Check if the procedure is passive.
Set_Passive_Flag (Subprg, True);
Set_All_Sensitized_State (Subprg, Unknown);
declare
Inter : Iir;
begin
Inter := Interface_Chain;
while Inter /= Null_Iir loop
if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration
and then Get_Mode (Inter) /= Iir_In_Mode
then
-- There is a driver for this signal interface.
Set_Passive_Flag (Subprg, False);
exit;
end if;
Inter := Get_Chain (Inter);
end loop;
end;
-- Mark the procedure as suspendable, unless in a std packages.
-- This is a minor optimization.
if Get_Library (Get_Design_File (Get_Current_Design_Unit))
/= Libraries.Std_Library
then
Set_Suspend_Flag (Subprg, True);
end if;
when others =>
Error_Kind ("sem_subprogram_declaration", Subprg);
end case;
Check_Operator_Requirements (Get_Identifier (Subprg), Subprg);
Compute_Subprogram_Hash (Subprg);
-- The specification has been semantized, close the declarative region
-- now.
Close_Declarative_Region;
-- Look if there is an associated body (the next node).
Subprg_Body := Get_Chain (Subprg);
if Subprg_Body /= Null_Iir
and then (Get_Kind (Subprg_Body) = Iir_Kind_Function_Body
or else Get_Kind (Subprg_Body) = Iir_Kind_Procedure_Body)
then
Spec := Find_Subprogram_Specification (Subprg);
else
Spec := Null_Iir;
end if;
if Spec /= Null_Iir then
-- SUBPRG is the body of the specification SPEC.
if Get_Subprogram_Body (Spec) /= Null_Iir then
Error_Msg_Sem
(Disp_Node (Spec) & " body already defined at "
& Files_Map.Image (Get_Location (Get_Subprogram_Body (Spec))),
Subprg);
-- Kill warning.
Set_Use_Flag (Subprg, True);
else
Check_Conformance_Rules (Subprg, Spec);
Xref_Body (Subprg, Spec);
Set_Subprogram_Body (Subprg, Subprg_Body);
Set_Subprogram_Specification (Subprg_Body, Spec);
Set_Subprogram_Body (Spec, Subprg_Body);
end if;
else
-- Forward declaration or specification followed by body.
Set_Subprogram_Overload_Number (Subprg);
Sem_Scopes.Add_Name (Subprg);
Name_Visible (Subprg);
Xref_Decl (Subprg);
end if;
end Sem_Subprogram_Declaration;
procedure Add_Analysis_Checks_List (El : Iir)
is
Design : constant Iir := Get_Current_Design_Unit;
List : Iir_List;
begin
List := Get_Analysis_Checks_List (Design);
if List = Null_Iir_List then
List := Create_Iir_List;
Set_Analysis_Checks_List (Design, List);
end if;
Add_Element (List, El);
end Add_Analysis_Checks_List;
procedure Sem_Subprogram_Body (Subprg : Iir)
is
Spec : constant Iir := Get_Subprogram_Specification (Subprg);
El : Iir;
begin
Set_Impure_Depth (Subprg, Iir_Depth_Pure);
-- LRM 10.1 Declarative regions
-- 3. A subprogram declaration, together with the corresponding
-- subprogram body.
Open_Declarative_Region;
Set_Is_Within_Flag (Spec, True);
-- Add the interface names into the current declarative region.
El := Get_Interface_Declaration_Chain (Spec);
while El /= Null_Iir loop
Add_Name (El, Get_Identifier (El), False);
if Get_Kind (El) = Iir_Kind_Interface_Signal_Declaration then
Set_Has_Active_Flag (El, False);
end if;
El := Get_Chain (El);
end loop;
Sem_Sequential_Statements (Spec, Subprg);
Set_Is_Within_Flag (Spec, False);
Close_Declarative_Region;
case Get_Kind (Spec) is
when Iir_Kind_Procedure_Declaration =>
if Get_Suspend_Flag (Subprg)
and then not Get_Suspend_Flag (Spec)
then
-- Incoherence: procedures declared in std library are not
-- expected to suspend. This is an internal check.
Error_Msg_Sem ("unexpected suspendable procedure", Subprg);
end if;
-- Update purity state of procedure if there are no callees.
case Get_Purity_State (Spec) is
when Pure
| Maybe_Impure =>
-- We can't know this yet.
raise Internal_Error;
when Impure =>
null;
when Unknown =>
if Get_Callees_List (Subprg) = Null_Iir_List then
-- Since there are no callees, purity state can
-- be updated.
if Get_Impure_Depth (Subprg) = Iir_Depth_Pure then
Set_Purity_State (Spec, Pure);
else
Set_Purity_State (Spec, Maybe_Impure);
end if;
end if;
end case;
-- Update wait state if the state of all callees is known.
if Get_Wait_State (Spec) = Unknown then
declare
Callees : Iir_List;
Callee : Iir;
State : Tri_State_Type;
begin
Callees := Get_Callees_List (Subprg);
-- Per default, has no wait.
Set_Wait_State (Spec, False);
if Callees /= Null_Iir_List then
for I in Natural loop
Callee := Get_Nth_Element (Callees, I);
exit when Callee = Null_Iir;
case Get_Kind (Callee) is
when Iir_Kind_Function_Declaration =>
null;
when Iir_Kind_Procedure_Declaration =>
State := Get_Wait_State (Callee);
case State is
when False =>
null;
when Unknown =>
-- Yet unknown, but can be TRUE.
Set_Wait_State (Spec, Unknown);
when True =>
-- Can this happen ?
raise Internal_Error;
--Set_Wait_State (Spec, True);
--exit;
end case;
when others =>
Error_Kind ("sem_subprogram_body(2)", Callee);
end case;
end loop;
end if;
end;
end if;
-- Set All_Sensitized_State in trivial cases.
if Get_All_Sensitized_State (Spec) = Unknown
and then Get_Callees_List (Subprg) = Null_Iir_List
then
Set_All_Sensitized_State (Spec, No_Signal);
end if;
-- Do not add to Analysis_Check_List as procedures can't
-- generate purity/wait/all-sensitized errors by themselves.
when Iir_Kind_Function_Declaration =>
if Get_Callees_List (Subprg) /= Null_Iir_List then
-- Purity calls to be checked later.
-- No wait statements in procedures called.
Add_Analysis_Checks_List (Spec);
end if;
when others =>
Error_Kind ("sem_subprogram_body", Spec);
end case;
end Sem_Subprogram_Body;
-- Status of Update_And_Check_Pure_Wait.
type Update_Pure_Status is
(
-- The purity/wait/all-sensitized are computed and known.
Update_Pure_Done,
-- A missing body prevents from computing the purity/wait/all-sensitized
Update_Pure_Missing,
-- Purity/wait/all-sensitized is unknown (recursion).
Update_Pure_Unknown
);
function Update_And_Check_Pure_Wait (Subprg : Iir) return Update_Pure_Status
is
procedure Error_Wait (Caller : Iir; Callee : Iir) is
begin
Error_Msg_Sem
(Disp_Node (Caller) & " must not contain wait statement, but calls",
Caller);
Error_Msg_Sem
(Disp_Node (Callee) & " which has (indirectly) a wait statement",
Callee);
end Error_Wait;
-- Kind of subprg.
type Caller_Kind is (K_Function, K_Process, K_Procedure);
Kind : Caller_Kind;
Callees_List : Iir_List;
Callees_List_Holder : Iir;
Callee : Iir;
Callee_Orig : Iir;
Callee_Bod : Iir;
Subprg_Depth : Iir_Int32;
Subprg_Bod : Iir;
-- Current purity depth of SUBPRG.
Depth : Iir_Int32;
Depth_Callee : Iir_Int32;
Has_Wait_Errors : Boolean := False;
Npos : Natural;
Res, Res1 : Update_Pure_Status;
begin
case Get_Kind (Subprg) is
when Iir_Kind_Function_Declaration =>
Kind := K_Function;
Subprg_Bod := Get_Subprogram_Body (Subprg);
Subprg_Depth := Get_Subprogram_Depth (Subprg);
Callees_List_Holder := Subprg_Bod;
if Get_Pure_Flag (Subprg) then
Depth := Iir_Depth_Pure;
else
Depth := Iir_Depth_Impure;
end if;
when Iir_Kind_Procedure_Declaration =>
Kind := K_Procedure;
Subprg_Bod := Get_Subprogram_Body (Subprg);
if Get_Purity_State (Subprg) = Impure
and then Get_Wait_State (Subprg) /= Unknown
and then Get_All_Sensitized_State (Subprg) /= Unknown
then
-- No need to go further.
if Get_All_Sensitized_State (Subprg) = No_Signal
or else Vhdl_Std < Vhdl_08
then
Callees_List := Get_Callees_List (Subprg_Bod);
Destroy_Iir_List (Callees_List);
Set_Callees_List (Subprg_Bod, Null_Iir_List);
end if;
return Update_Pure_Done;
end if;
Subprg_Depth := Get_Subprogram_Depth (Subprg);
Depth := Get_Impure_Depth (Subprg_Bod);
Callees_List_Holder := Subprg_Bod;
when Iir_Kind_Sensitized_Process_Statement =>
Kind := K_Process;
Subprg_Bod := Null_Iir;
Subprg_Depth := Iir_Depth_Top;
Depth := Iir_Depth_Impure;
Callees_List_Holder := Subprg;
when others =>
Error_Kind ("update_and_check_pure_wait(1)", Subprg);
end case;
-- If the subprogram has no callee list, there is nothing to do.
Callees_List := Get_Callees_List (Callees_List_Holder);
if Callees_List = Null_Iir_List then
-- There are two reasons why a callees_list is null:
-- * either because SUBPRG does not call any procedure
-- in this case, the status are already known and we should have
-- returned in the above case.
-- * or because of a recursion
-- in this case the status are still unknown here.
return Update_Pure_Unknown;
end if;
-- By default we don't know the status.
Res := Update_Pure_Unknown;
-- This subprogram is being considered.
-- To avoid infinite loop, suppress its callees list.
Set_Callees_List (Callees_List_Holder, Null_Iir_List);
-- First loop: check without recursion.
-- Second loop: recurse if necessary.
for J in 0 .. 1 loop
Npos := 0;
for I in Natural loop
Callee := Get_Nth_Element (Callees_List, I);
exit when Callee = Null_Iir;
-- Note:
-- Pure functions should not be in the list.
-- Impure functions must have directly set Purity_State.
-- Check pure.
Callee_Bod := Get_Subprogram_Body (Callee);
if Callee_Bod = Null_Iir then
-- The body of subprograms may not be set for instances.
-- Use the body from the generic (if any).
Callee_Orig := Sem_Inst.Get_Origin (Callee);
if Callee_Orig /= Null_Iir then
Callee_Bod := Get_Subprogram_Body (Callee_Orig);
Set_Subprogram_Body (Callee, Callee_Bod);
end if;
end if;
if Callee_Bod = Null_Iir then
-- No body yet for the subprogram called.
-- Nothing can be extracted from it, postpone the checks until
-- elaboration.
Res := Update_Pure_Missing;
else
-- Second loop: recurse if a state is not known.
if J = 1
and then
((Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
and then Get_Purity_State (Callee) = Unknown)
or else Get_Wait_State (Callee) = Unknown
or else Get_All_Sensitized_State (Callee) = Unknown)
then
Res1 := Update_And_Check_Pure_Wait (Callee);
if Res1 = Update_Pure_Missing then
Res := Update_Pure_Missing;
end if;
end if;
-- Check purity only if the subprogram is not impure.
if Depth /= Iir_Depth_Impure then
Depth_Callee := Get_Impure_Depth (Callee_Bod);
-- Check purity depth.
if Depth_Callee < Subprg_Depth then
-- The call is an impure call because it calls an outer
-- subprogram (or an impure subprogram).
-- FIXME: check the compare.
Depth_Callee := Iir_Depth_Impure;
if Kind = K_Function then
-- FIXME: report call location
Error_Pure (Elaboration, Subprg_Bod, Callee, Null_Iir);
end if;
end if;
-- Update purity depth.
if Depth_Callee < Depth then
Depth := Depth_Callee;
if Kind = K_Procedure then
-- Update for recursivity.
Set_Impure_Depth (Subprg_Bod, Depth);
if Depth = Iir_Depth_Impure then
Set_Purity_State (Subprg, Impure);
end if;
end if;
end if;
end if;
end if;
-- Check wait.
if Has_Wait_Errors = False
and then Get_Wait_State (Callee) = True
then
if Kind = K_Procedure then
Set_Wait_State (Subprg, True);
else
Error_Wait (Subprg, Callee);
Has_Wait_Errors := True;
end if;
end if;
if Get_All_Sensitized_State (Callee) = Invalid_Signal then
case Kind is
when K_Function | K_Procedure =>
Set_All_Sensitized_State (Subprg, Invalid_Signal);
when K_Process =>
-- LRM08 11.3
--
-- It is an error if a process statement with the
-- reserved word ALL as its process sensitivity list
-- is the parent of a subprogram declared in a design
-- unit other than that containing the process statement
-- and the subprogram reads an explicitly declared
-- signal that is not a formal signal parameter or
-- member of a formal signal parameter of the
-- subprogram or of any of its parents. Similarly,
-- it is an error if such subprogram reads an implicit
-- signal whose explicit ancestor is not a formal signal
-- parameter or member of a formal parameter of
-- the subprogram or of any of its parents.
Error_Msg_Sem
("all-sensitized " & Disp_Node (Subprg)
& " can't call " & Disp_Node (Callee), Subprg);
Error_Msg_Sem
(" (as this subprogram reads (indirectly) a signal)",
Subprg);
end case;
end if;
-- Keep in list.
if Callee_Bod = Null_Iir
or else
(Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
and then Get_Purity_State (Callee) = Unknown
and then Depth /= Iir_Depth_Impure)
or else
(Get_Wait_State (Callee) = Unknown
and then (Kind /= K_Procedure
or else Get_Wait_State (Subprg) = Unknown))
or else
(Vhdl_Std >= Vhdl_08
and then
(Get_All_Sensitized_State (Callee) = Unknown
or else Get_All_Sensitized_State (Callee) = Read_Signal))
then
Replace_Nth_Element (Callees_List, Npos, Callee);
Npos := Npos + 1;
end if;
end loop;
-- End of callee loop.
if Npos = 0 then
Destroy_Iir_List (Callees_List);
Callees_List := Null_Iir_List;
if Kind = K_Procedure then
if Get_Purity_State (Subprg) = Unknown then
Set_Purity_State (Subprg, Maybe_Impure);
end if;
if Get_Wait_State (Subprg) = Unknown then
Set_Wait_State (Subprg, False);
end if;
end if;
if Kind = K_Procedure or Kind = K_Function then
if Get_All_Sensitized_State (Subprg) = Unknown then
Set_All_Sensitized_State (Subprg, No_Signal);
end if;
end if;
Res := Update_Pure_Done;
exit;
else
Set_Nbr_Elements (Callees_List, Npos);
end if;
end loop;
Set_Callees_List (Callees_List_Holder, Callees_List);
return Res;
end Update_And_Check_Pure_Wait;
-- Check pure/wait/all-sensitized issues for SUBPRG (subprogram or
-- process). Return False if the analysis is incomplete (and must
-- be deferred).
function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean
is
Res : Update_Pure_Status;
begin
Res := Update_And_Check_Pure_Wait (Subprg);
case Res is
when Update_Pure_Done =>
return True;
when Update_Pure_Missing =>
return False;
when Update_Pure_Unknown =>
-- The purity/wait is unknown, but all callee were walked.
-- This means there are recursive calls but without violations.
if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
if Get_Purity_State (Subprg) = Unknown then
Set_Purity_State (Subprg, Maybe_Impure);
end if;
if Get_Wait_State (Subprg) = Unknown then
Set_Wait_State (Subprg, False);
end if;
end if;
if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
if Get_All_Sensitized_State (Subprg) = Unknown then
Set_All_Sensitized_State (Subprg, No_Signal);
end if;
end if;
return True;
end case;
end Root_Update_And_Check_Pure_Wait;
procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
Emit_Warnings : Boolean)
is
List : Iir_List := Get_Analysis_Checks_List (Unit);
El : Iir;
Npos : Natural;
Keep : Boolean;
Callees : Iir_List;
Callee : Iir;
begin
if List = Null_Iir_List then
-- Return now if there is nothing to check.
return;
end if;
Npos := 0;
for I in Natural loop
El := Get_Nth_Element (List, I);
exit when El = Null_Iir;
Keep := False;
case Get_Kind (El) is
when Iir_Kind_Function_Declaration =>
-- FIXME: remove from list if fully tested ?
if not Root_Update_And_Check_Pure_Wait (El) then
Keep := True;
if Emit_Warnings then
Callees := Get_Callees_List (El);
pragma Assert (Callees /= Null_Iir_List);
Warning_Msg_Sem
("can't assert that all calls in " & Disp_Node (El)
& " are pure or have not wait; "
& "will be checked at elaboration", El);
Callee := Get_Nth_Element (Callees, 0);
-- FIXME: could improve this message by displaying the
-- chain of calls until the first subprograms in
-- unknown state.
Warning_Msg_Sem
("(first such call is to " & Disp_Node (Callee) & ")",
Callee);
end if;
end if;
when Iir_Kind_Sensitized_Process_Statement =>
if not Root_Update_And_Check_Pure_Wait (El) then
Keep := True;
if Emit_Warnings then
Warning_Msg_Sem
("can't assert that " & Disp_Node (El)
& " has not wait; will be checked at elaboration", El);
end if;
end if;
when others =>
Error_Kind ("sem_analysis_checks_list", El);
end case;
if Keep then
Replace_Nth_Element (List, Npos, El);
Npos := Npos + 1;
end if;
end loop;
if Npos = 0 then
Destroy_Iir_List (List);
Set_Analysis_Checks_List (Unit, Null_Iir_List);
else
Set_Nbr_Elements (List, Npos);
end if;
end Sem_Analysis_Checks_List;
-- Return true if package declaration DECL needs a body.
-- Ie, it contains subprogram specification or deferred constants.
function Package_Need_Body_P (Decl: Iir_Package_Declaration)
return Boolean
is
El: Iir;
Def : Iir;
begin
El := Get_Declaration_Chain (Decl);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
if not Is_Implicit_Subprogram (El) then
return True;
end if;
when Iir_Kind_Constant_Declaration =>
if Get_Default_Value (El) = Null_Iir then
return True;
end if;
when Iir_Kind_Variable_Declaration
| Iir_Kind_File_Declaration
| Iir_Kind_Signal_Declaration
| Iir_Kind_Object_Alias_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Group_Template_Declaration
| Iir_Kind_Group_Declaration =>
null;
when Iir_Kind_Type_Declaration =>
Def := Get_Type_Definition (El);
if Def /= Null_Iir
and then Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
then
return True;
end if;
when Iir_Kind_Anonymous_Type_Declaration
| Iir_Kind_Subtype_Declaration =>
null;
when Iir_Kind_Attribute_Declaration
| Iir_Kind_Attribute_Specification =>
null;
when Iir_Kind_Disconnection_Specification =>
null;
when Iir_Kind_Use_Clause =>
null;
when Iir_Kind_Component_Declaration =>
null;
when Iir_Kind_Protected_Type_Body =>
null;
when Iir_Kind_Nature_Declaration
| Iir_Kind_Subnature_Declaration =>
null;
when Iir_Kind_Terminal_Declaration =>
null;
when others =>
Error_Kind ("package_need_body_p", El);
end case;
El := Get_Chain (El);
end loop;
return False;
end Package_Need_Body_P;
-- LRM 2.5 Package Declarations.
procedure Sem_Package_Declaration (Decl: Iir_Package_Declaration)
is
Unit : Iir_Design_Unit;
Implicit : Implicit_Signal_Declaration_Type;
Header : constant Iir := Get_Package_Header (Decl);
begin
Unit := Get_Design_Unit (Decl);
Sem_Scopes.Add_Name (Decl);
Set_Visible_Flag (Decl, True);
Xref_Decl (Decl);
-- Identify IEEE.Std_Logic_1164 for VHDL08.
if Get_Identifier (Decl) = Std_Names.Name_Std_Logic_1164
and then (Get_Identifier (Get_Library (Get_Design_File (Unit)))
= Std_Names.Name_Ieee)
then
Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Decl;
end if;
-- LRM93 10.1 Declarative Region
-- 4. A package declaration, together with the corresponding
-- body (if any).
Open_Declarative_Region;
Push_Signals_Declarative_Part (Implicit, Decl);
if Header /= Null_Iir then
Sem_Interface_Chain
(Get_Generic_Chain (Header), Generic_Interface_List);
if Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir then
-- FIXME: todo
raise Internal_Error;
end if;
end if;
Sem_Declaration_Chain (Decl);
-- GHDL: subprogram bodies appear in package body.
Pop_Signals_Declarative_Part (Implicit);
Close_Declarative_Region;
Set_Need_Body (Decl, Package_Need_Body_P (Decl));
end Sem_Package_Declaration;
-- LRM 2.6 Package Bodies.
procedure Sem_Package_Body (Decl: Iir)
is
Package_Ident: Name_Id;
Design_Unit: Iir_Design_Unit;
Package_Decl: Iir;
begin
-- First, find the package declaration.
Package_Ident := Get_Identifier (Decl);
Design_Unit := Libraries.Load_Primary_Unit
(Get_Library (Get_Design_File (Get_Current_Design_Unit)),
Package_Ident, Decl);
if Design_Unit = Null_Iir then
Error_Msg_Sem ("package '" & Name_Table.Image (Package_Ident)
& "' was not analysed",
Decl);
return;
end if;
Package_Decl := Get_Library_Unit (Design_Unit);
if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
Error_Msg_Sem
("primary unit '" & Name_Table.Image (Package_Ident)
& "' is not a package", Decl);
return;
end if;
-- Emit a warning is a body is not necessary.
if not Get_Need_Body (Package_Decl) then
Warning_Msg_Sem
(Disp_Node (Package_Decl) & " does not require a body", Decl);
end if;
Set_Package (Decl, Package_Decl);
Xref_Body (Decl, Package_Decl);
Set_Package_Body (Package_Decl, Decl);
Add_Dependence (Design_Unit);
Add_Name (Design_Unit);
-- Add the context clauses from the primary unit.
Add_Context_Clauses (Design_Unit);
-- LRM93 10.1 Declarative Region
-- 4. A package declaration, together with the corresponding
-- body (if any).
Open_Declarative_Region;
Sem_Scopes.Add_Package_Declarations (Package_Decl);
Sem_Declaration_Chain (Decl);
Check_Full_Declaration (Decl, Decl);
Check_Full_Declaration (Package_Decl, Decl);
Close_Declarative_Region;
end Sem_Package_Body;
function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir
is
Name : Iir;
Pkg : Iir;
begin
Name := Sem_Denoting_Name (Get_Uninstantiated_Package_Name (Decl));
Set_Uninstantiated_Package_Name (Decl, Name);
Pkg := Get_Named_Entity (Name);
if Get_Kind (Pkg) /= Iir_Kind_Package_Declaration then
Error_Class_Match (Name, "package");
-- What could be done ?
return Null_Iir;
elsif not Is_Uninstantiated_Package (Pkg) then
Error_Msg_Sem
(Disp_Node (Pkg) & " is not an uninstantiated package", Name);
-- What could be done ?
return Null_Iir;
end if;
return Pkg;
end Sem_Uninstantiated_Package_Name;
-- LRM08 4.9 Package Instantiation Declaration
procedure Sem_Package_Instantiation_Declaration (Decl : Iir)
is
Hdr : Iir;
Pkg : Iir;
Bod : Iir_Design_Unit;
begin
Sem_Scopes.Add_Name (Decl);
Set_Visible_Flag (Decl, True);
Xref_Decl (Decl);
-- LRM08 4.9
-- The uninstantiated package name shall denote an uninstantiated
-- package declared in a package declaration.
Pkg := Sem_Uninstantiated_Package_Name (Decl);
if Pkg = Null_Iir then
-- What could be done ?
return;
end if;
-- LRM08 4.9
-- The generic map aspect, if present, optionally associates a single
-- actual with each formal generic (or member thereof) in the
-- corresponding package declaration. Each formal generic (or member
-- thereof) shall be associated at most once.
-- GHDL: the generics are first instantiated (ie copied) and then
-- the actuals are associated with the instantiated formal.
-- FIXME: do it in Instantiate_Package_Declaration ?
Hdr := Get_Package_Header (Pkg);
if Sem_Generic_Association_Chain (Hdr, Decl) then
Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg);
else
-- FIXME: stop analysis here ?
null;
end if;
-- FIXME: unless the parent is a package declaration library unit, the
-- design unit depends on the body.
Bod := Libraries.Load_Secondary_Unit
(Get_Design_Unit (Pkg), Null_Identifier, Decl);
if Bod /= Null_Iir then
Add_Dependence (Bod);
end if;
end Sem_Package_Instantiation_Declaration;
-- LRM 10.4 Use Clauses.
procedure Sem_Use_Clause (Clauses: Iir_Use_Clause)
is
Clause : Iir_Use_Clause;
Name: Iir;
Prefix: Iir;
Name_Prefix : Iir;
begin
Clause := Clauses;
loop
-- LRM93 10.4
-- A use clause achieves direct visibility of declarations that are
-- visible by selection.
-- Each selected name is a use clause identifies one or more
-- declarations that will potentialy become directly visible.
Name := Get_Selected_Name (Clause);
case Get_Kind (Name) is
when Iir_Kind_Selected_By_All_Name
| Iir_Kind_Selected_Name =>
Name_Prefix := Get_Prefix (Name);
when others =>
Error_Msg_Sem ("use clause allows only selected name", Name);
return;
end case;
Name_Prefix := Sem_Denoting_Name (Name_Prefix);
Set_Prefix (Name, Name_Prefix);
Prefix := Get_Named_Entity (Name_Prefix);
if Is_Error (Prefix) 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
-- the prefix of the selected name.
--
-- If the suffix is the reserved word ALL, then the selected name
-- identifies all declarations that are contained within the package
-- or library denoted by the prefix of the selected name.
--
-- GHDL: therefore, the suffix must be either a package or a library.
case Get_Kind (Prefix) is
when Iir_Kind_Library_Declaration =>
null;
when Iir_Kind_Package_Instantiation_Declaration
| Iir_Kind_Interface_Package_Declaration =>
null;
when Iir_Kind_Package_Declaration =>
-- LRM08 12.4 Use clauses
-- It is an error if the prefix of a selected name in a use
-- clause denotes an uninstantiated package.
if Is_Uninstantiated_Package (Prefix) then
Error_Msg_Sem
("use of uninstantiated package is not allowed",
Name_Prefix);
return;
end if;
when others =>
Error_Msg_Sem
("prefix must designate a package or a library", Prefix);
return;
end case;
case Get_Kind (Name) is
when Iir_Kind_Selected_Name =>
Sem_Name (Name);
case Get_Kind (Get_Named_Entity (Name)) is
when Iir_Kind_Error =>
-- Continue in case of error.
null;
when Iir_Kind_Overload_List =>
-- Analyze is correct as is.
null;
when others =>
Name := Finish_Sem_Name (Name);
Set_Selected_Name (Clause, Name);
end case;
when Iir_Kind_Selected_By_All_Name =>
null;
when others =>
raise Internal_Error;
end case;
Clause := Get_Use_Clause_Chain (Clause);
exit when Clause = Null_Iir;
end loop;
-- LRM 10.4
-- For each use clause, there is a certain region of text called the
-- scope of the use clause. This region starts immediatly after the
-- use clause.
Sem_Scopes.Add_Use_Clause (Clauses);
end Sem_Use_Clause;
-- LRM 11.2 Design Libraries.
procedure Sem_Library_Clause (Decl: Iir_Library_Clause)
is
Ident : Name_Id;
Lib: Iir;
begin
-- GHDL: 'redeclaration' is handled in sem_scopes.
Ident := Get_Identifier (Decl);
Lib := Libraries.Get_Library (Ident, Get_Location (Decl));
if Lib = Null_Iir then
Error_Msg_Sem
("no resource library """ & Name_Table.Image (Ident) & """", Decl);
else
Set_Library_Declaration (Decl, Lib);
Sem_Scopes.Add_Name (Lib, Ident, False);
Set_Visible_Flag (Lib, True);
Xref_Ref (Decl, Lib);
end if;
end Sem_Library_Clause;
-- LRM08 13.4 Context clauses.
procedure Sem_One_Context_Reference (Ref : Iir)
is
Name : Iir;
Ent : Iir;
begin
Name := Get_Selected_Name (Ref);
if Get_Kind (Name) /= Iir_Kind_Selected_Name then
Error_Msg_Sem
("context reference only allows selected names", Name);
return;
end if;
Name := Sem_Denoting_Name (Name);
Set_Selected_Name (Ref, Name);
Ent := Get_Named_Entity (Name);
if Is_Error (Ent) then
return;
end if;
-- LRM08 13.4 Context clauses
-- It is an error if a selected name in a context reference does not
-- denote a context declaration.
if Get_Kind (Ent) /= Iir_Kind_Context_Declaration then
Error_Msg_Sem ("name must denote a context declaration", Name);
Set_Named_Entity (Name, Null_Iir);
return;
end if;
end Sem_One_Context_Reference;
-- LRM08 13.4 Context clauses.
procedure Sem_Context_Reference (Ctxt : Iir)
is
Ref : Iir;
begin
Ref := Ctxt;
loop
Sem_One_Context_Reference (Ref);
Ref := Get_Context_Reference_Chain (Ref);
exit when Ref = Null_Iir;
end loop;
-- FIXME: must be done clause after clause ?
Add_Context_Reference (Ctxt);
end Sem_Context_Reference;
-- LRM 11.3 Context Clauses.
procedure Sem_Context_Clauses (Unit: Iir)
is
El: Iir;
begin
El := Get_Context_Items (Unit);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Use_Clause =>
Sem_Use_Clause (El);
when Iir_Kind_Library_Clause =>
Sem_Library_Clause (El);
when Iir_Kind_Context_Reference =>
Sem_Context_Reference (El);
when others =>
Error_Kind ("sem_context_clauses", El);
end case;
El := Get_Chain (El);
end loop;
end Sem_Context_Clauses;
-- LRM08 13.3 Context declarations
procedure Sem_Context_Declaration (Decl: Iir)
is
-- Return TRUE iff the first prefix of NAME denotes library WORK.
function Has_Work_Library_Prefix (Name : Iir) return Boolean
is
Prefix : Iir;
begin
Prefix := Name;
while Get_Kind (Prefix) = Iir_Kind_Selected_Name
or else Get_Kind (Prefix) = Iir_Kind_Selected_By_All_Name
loop
Prefix := Get_Prefix (Prefix);
end loop;
return Get_Kind (Prefix) = Iir_Kind_Simple_Name
and then Get_Identifier (Prefix) = Std_Names.Name_Work
and then (Get_Kind (Get_Named_Entity (Prefix))
= Iir_Kind_Library_Declaration);
end Has_Work_Library_Prefix;
procedure Error_Work_Prefix (Loc : Iir) is
begin
Error_Msg_Sem
("'work' not allowed as prefix in context declaration", Loc);
end Error_Work_Prefix;
El : Iir;
El1 : Iir;
begin
Sem_Scopes.Add_Name (Decl);
Xref_Decl (Decl);
Sem_Context_Clauses (Decl);
El := Get_Context_Items (Decl);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Library_Clause =>
-- LRM08 13.3 Context declarations
-- It is an error if a library clause in a context declaration
-- defines the library logical name WORK, [...]
if Get_Identifier (El) = Std_Names.Name_Work then
Error_Msg_Sem
("'library work' not allowed in context declaration", El);
end if;
when Iir_Kind_Use_Clause =>
-- LRM08 13.3 Context declarations
-- [...] or if a selected name in a use clause [or a context
-- reference] in a context declaration has the library logic
-- name WORK as a prefix.
El1 := El;
while El1 /= Null_Iir loop
if Has_Work_Library_Prefix (Get_Selected_Name (El1)) then
Error_Work_Prefix (El1);
exit;
end if;
El1 := Get_Use_Clause_Chain (El1);
end loop;
when Iir_Kind_Context_Reference =>
-- LRM08 13.3 Context declarations
-- [...] or if a selected name in [a use clause or] a context
-- reference in a context declaration has the library logic
-- name WORK as a prefix.
El1 := El;
while El1 /= Null_Iir loop
if Has_Work_Library_Prefix (Get_Selected_Name (El1)) then
Error_Work_Prefix (El1);
exit;
end if;
El1 := Get_Context_Reference_Chain (El1);
end loop;
when others =>
raise Internal_Error;
end case;
El := Get_Chain (El);
end loop;
-- GHDL: forbid self-reference by making declaration visible at the end.
-- This violates LRM08 12.3 Visibility: A declaration is visible only
-- within a certain part of its scope; ...
Set_Visible_Flag (Decl, True);
end Sem_Context_Declaration;
-- Access to the current design unit. This is set, saved, restored, cleared
-- by the procedure semantic.
Current_Design_Unit: Iir_Design_Unit := Null_Iir;
function Get_Current_Design_Unit return Iir_Design_Unit is
begin
return Current_Design_Unit;
end Get_Current_Design_Unit;
-- LRM 11.1 Design units.
procedure Semantic (Design_Unit: Iir_Design_Unit)
is
El: Iir;
Old_Design_Unit: Iir_Design_Unit;
Implicit : Implicit_Signal_Declaration_Type;
begin
-- Sanity check: can analyze either previously analyzed unit or just
-- parsed unit.
case Get_Date (Design_Unit) is
when Date_Parsed =>
Set_Date (Design_Unit, Date_Analyzing);
when Date_Valid =>
null;
when Date_Obsolete =>
-- This happens only when design files are added into the library
-- and keeping obsolete units (eg: to pretty print a file).
Set_Date (Design_Unit, Date_Analyzing);
when others =>
raise Internal_Error;
end case;
-- Save and set current_design_unit.
Old_Design_Unit := Current_Design_Unit;
Current_Design_Unit := Design_Unit;
Push_Signals_Declarative_Part (Implicit, Null_Iir);
-- Have a clean and empty state for scopes.
Push_Interpretations;
-- LRM02 10.1 Declarative Region.
-- In addition to the above declarative region, there is a root
-- declarative region, not associated with a portion of the text of the
-- description, but encompassing any given primary unit. At the
-- beginning of the analysis of a given primary unit, there are no
-- declarations whose scopes (see 10.2) are within the root declarative
-- region. Moreover, the root declarative region associated with any
-- given secondary unit is the root declarative region of the
-- corresponding primary unit.
-- GHDL: for any revision of VHDL, a root declarative region is created,
-- due to reasons given by LCS 3 (VHDL Issue # 1028).
Open_Declarative_Region;
-- Set_Dependence_List (Design_Unit,
-- Create_Iir (Iir_Kind_Design_Unit_List));
-- LRM 11.2
-- Every design unit is assumed to contain the following implicit
-- context items as part of its context clause:
-- library STD, WORK; use STD.STANDARD.all;
Sem_Scopes.Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False);
Sem_Scopes.Add_Name (Get_Library (Get_Design_File (Design_Unit)),
Std_Names.Name_Work,
False);
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;
Add_Dependence (Std_Standard_Unit);
-- Semantic on context clauses.
Sem_Context_Clauses (Design_Unit);
-- semantic on the library unit.
El := Get_Library_Unit (Design_Unit);
case Get_Kind (El) is
when Iir_Kind_Entity_Declaration =>
Sem_Entity_Declaration (El);
when Iir_Kind_Architecture_Body =>
Sem_Architecture_Body (El);
when Iir_Kind_Package_Declaration =>
Sem_Package_Declaration (El);
when Iir_Kind_Package_Body =>
Sem_Package_Body (El);
when Iir_Kind_Configuration_Declaration =>
Sem_Configuration_Declaration (El);
when Iir_Kind_Package_Instantiation_Declaration =>
Sem_Package_Instantiation_Declaration (El);
when Iir_Kind_Context_Declaration =>
Sem_Context_Declaration (El);
when others =>
Error_Kind ("semantic", El);
end case;
Close_Declarative_Region;
Pop_Interpretations;
if Get_Date (Design_Unit) = Date_Analyzing then
Set_Date (Design_Unit, Date_Analyzed);
end if;
if Get_Analysis_Checks_List (Design_Unit) /= Null_Iir_List then
Sem_Analysis_Checks_List (Design_Unit, False);
end if;
-- Restore current_design_unit.
Current_Design_Unit := Old_Design_Unit;
Pop_Signals_Declarative_Part (Implicit);
end Semantic;
end Sem;