diff options
Diffstat (limited to 'sem.adb')
| -rw-r--r-- | sem.adb | 138 |
1 files changed, 90 insertions, 48 deletions
@@ -72,10 +72,10 @@ package body Sem is Open_Declarative_Region; -- Sem generics. - Sem_Interface_Chain (Get_Generic_Chain (Entity), Interface_Generic); + Sem_Interface_Chain (Get_Generic_Chain (Entity), Generic_Interface_List); -- Sem ports. - Sem_Interface_Chain (Get_Port_Chain (Entity), Interface_Port); + Sem_Interface_Chain (Get_Port_Chain (Entity), Port_Interface_List); -- Entity declarative part and concurrent statements. Sem_Block (Entity, True); @@ -230,7 +230,7 @@ package body Sem is return Res; end if; when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => null; when Iir_Kind_Object_Alias_Declaration => @@ -352,6 +352,7 @@ package body Sem is El : Iir; Match : Boolean; Assoc_Chain : Iir; + Inter_Chain : Iir; Miss : Missing_Type; begin -- LRM08 6.5.6.2 Generic clauses @@ -398,11 +399,17 @@ package body Sem is 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 Sem_Actual_Of_Association_Chain (Assoc_Chain) then Sem_Association_Chain - (Get_Generic_Chain (Inter_Parent), Assoc_Chain, - True, Miss, Assoc_Parent, Match); + (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match); Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain); -- LRM 5.2.1.2 Generic map and port map aspects @@ -414,9 +421,9 @@ package body Sem is case Get_Kind (El) is when Iir_Kind_Association_Element_By_Expression => Check_Read (Get_Actual (El)); - when Iir_Kind_Association_Element_Open => - null; - when Iir_Kind_Association_Element_By_Individual => + 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); @@ -522,7 +529,7 @@ package body Sem is end if; case Get_Kind (Prefix) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kinds_Signal_Attribute => -- Port or signal. @@ -531,8 +538,7 @@ package body Sem is 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_Signal_Interface_Declaration + if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then declare P : Boolean; @@ -1158,10 +1164,10 @@ package body Sem is return False; end if; return True; - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + 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; @@ -1683,15 +1689,16 @@ package body Sem is Interface_Chain := Get_Interface_Declaration_Chain (Subprg); case Get_Kind (Subprg) is when Iir_Kind_Function_Declaration => - Sem_Interface_Chain (Interface_Chain, Interface_Function); - -- FIXME: the return type is in fact a type mark. + 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); Set_Return_Type (Subprg, Get_Type (Return_Type)); Set_All_Sensitized_State (Subprg, Unknown); when Iir_Kind_Procedure_Declaration => - Sem_Interface_Chain (Interface_Chain, Interface_Procedure); + 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. @@ -1702,7 +1709,7 @@ package body Sem is begin Inter := Interface_Chain; while Inter /= Null_Iir loop - if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration + 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. @@ -1782,7 +1789,7 @@ package body Sem is El := Get_Interface_Declaration_Chain (Spec); while El /= Null_Iir loop Add_Name (El, Get_Identifier (El), False); - if Get_Kind (El) = Iir_Kind_Signal_Interface_Declaration then + if Get_Kind (El) = Iir_Kind_Interface_Signal_Declaration then Set_Has_Active_Flag (El, False); end if; El := Get_Chain (El); @@ -1804,7 +1811,7 @@ package body Sem is when Impure => null; when Unknown => - if Get_Callees_List (Spec) = Null_Iir_List then + 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 @@ -1822,7 +1829,7 @@ package body Sem is Callee : Iir; State : Tri_State_Type; begin - Callees := Get_Callees_List (Spec); + Callees := Get_Callees_List (Subprg); -- Per default, has no wait. Set_Wait_State (Spec, False); if Callees /= Null_Iir_List then @@ -1858,7 +1865,7 @@ package body Sem is -- Set All_Sensitized_State in trivial cases. if Get_All_Sensitized_State (Spec) = Unknown - and then Get_Callees_List (Spec) = Null_Iir_List + and then Get_Callees_List (Subprg) = Null_Iir_List then Set_All_Sensitized_State (Spec, No_Signal); end if; @@ -1867,7 +1874,7 @@ package body Sem is -- generate purity/wait/all-sensitized errors by themselves. when Iir_Kind_Function_Declaration => - if Get_Callees_List (Spec) /= Null_Iir_List then + 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); @@ -1904,8 +1911,10 @@ package body Sem is type Caller_Kind is (K_Function, K_Process, K_Procedure); Kind : Caller_Kind; - Callees_List : Iir_List := Get_Callees_List (Subprg); + Callees_List : Iir_List; + Callees_List_Holder : Iir; Callee : Iir; + Callee_Orig : Iir; Callee_Bod : Iir; Subprg_Depth : Iir_Int32; Subprg_Bod : Iir; @@ -1921,6 +1930,7 @@ package body Sem is 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 @@ -1929,6 +1939,7 @@ package body Sem is 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 @@ -1937,26 +1948,29 @@ package body Sem is 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, Null_Iir_List); + Set_Callees_List (Subprg_Bod, Null_Iir_List); end if; return Update_Pure_Done; end if; - Subprg_Bod := Get_Subprogram_Body (Subprg); 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 @@ -1972,7 +1986,7 @@ package body Sem is -- This subprogram is being considered. -- To avoid infinite loop, suppress its callees list. - Set_Callees_List (Subprg, Null_Iir_List); + Set_Callees_List (Callees_List_Holder, Null_Iir_List); -- First loop: check without recursion. -- Second loop: recurse if necessary. @@ -1988,6 +2002,17 @@ package body Sem is -- 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 @@ -2123,7 +2148,7 @@ package body Sem is end if; end loop; - Set_Callees_List (Subprg, Callees_List); + Set_Callees_List (Callees_List_Holder, Callees_List); return Res; end Update_And_Check_Pure_Wait; @@ -2172,8 +2197,10 @@ package body Sem is 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); @@ -2186,9 +2213,7 @@ package body Sem is Keep := True; if Emit_Warnings then Callees := Get_Callees_List (El); - if Callees = Null_Iir_List then - raise Internal_Error; - end if; + 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; " @@ -2318,7 +2343,8 @@ package body Sem is Push_Signals_Declarative_Part (Implicit, Decl); if Header /= Null_Iir then - Sem_Interface_Chain (Get_Generic_Chain (Header), Interface_Generic); + 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; @@ -2389,33 +2415,47 @@ package body Sem is Close_Declarative_Region; end Sem_Package_Body; - -- LRM08 4.9 Package Instantiation Declaration - procedure Sem_Package_Instantiation_Declaration (Decl : Iir) + function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir is Name : 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. - Name := Sem_Denoting_Name (Get_Uninstantiated_Name (Decl)); - Set_Uninstantiated_Name (Decl, Name); + 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; + 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; @@ -2428,8 +2468,9 @@ package body Sem is -- 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); + Sem_Generic_Association_Chain (Hdr, Decl); Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg); - Sem_Generic_Association_Chain (Decl, Decl); -- FIXME: unless the parent is a package declaration library unit, the -- design unit depends on the body. @@ -2489,7 +2530,8 @@ package body Sem is case Get_Kind (Prefix) is when Iir_Kind_Library_Declaration => null; - when Iir_Kind_Package_Instantiation_Declaration => + when Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Package_Declaration => null; when Iir_Kind_Package_Declaration => -- LRM08 12.4 Use clauses |