diff options
| -rw-r--r-- | canon.adb | 62 | ||||
| -rw-r--r-- | disp_vhdl.adb | 32 | ||||
| -rw-r--r-- | errorout.adb | 13 | ||||
| -rw-r--r-- | evaluation.adb | 27 | ||||
| -rw-r--r-- | ieee-vital_timing.adb | 36 | ||||
| -rw-r--r-- | iirs.adb | 40 | ||||
| -rw-r--r-- | iirs.ads | 127 | ||||
| -rw-r--r-- | iirs_utils.adb | 67 | ||||
| -rw-r--r-- | iirs_utils.ads | 7 | ||||
| -rw-r--r-- | libraries/Makefile.inc | 6 | ||||
| -rw-r--r-- | libraries/ieee2008/float_generic_pkg-body.vhdl | 10 | ||||
| -rw-r--r-- | nodes.ads | 527 | ||||
| -rw-r--r-- | nodes_gc.adb | 2 | ||||
| -rw-r--r-- | nodes_meta.adb | 701 | ||||
| -rw-r--r-- | nodes_meta.ads | 6 | ||||
| -rw-r--r-- | parse.adb | 606 | ||||
| -rw-r--r-- | sem.adb | 138 | ||||
| -rw-r--r-- | sem.ads | 5 | ||||
| -rw-r--r-- | sem_assocs.adb | 418 | ||||
| -rw-r--r-- | sem_assocs.ads | 9 | ||||
| -rw-r--r-- | sem_decls.adb | 498 | ||||
| -rw-r--r-- | sem_decls.ads | 6 | ||||
| -rw-r--r-- | sem_expr.adb | 25 | ||||
| -rw-r--r-- | sem_inst.adb | 219 | ||||
| -rw-r--r-- | sem_names.adb | 43 | ||||
| -rw-r--r-- | sem_scopes.adb | 17 | ||||
| -rw-r--r-- | sem_specs.adb | 10 | ||||
| -rw-r--r-- | sem_stmts.adb | 14 | ||||
| -rw-r--r-- | sem_types.adb | 22 | ||||
| -rw-r--r-- | std_package.adb | 12 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlprint.adb | 4 | ||||
| -rw-r--r-- | translate/trans_analyzes.adb | 4 | ||||
| -rw-r--r-- | translate/translation.adb | 384 | ||||
| -rwxr-xr-x | xtools/pnodes.py | 78 |
34 files changed, 2336 insertions, 1839 deletions
@@ -211,7 +211,7 @@ package body Canon is when Iir_Kind_Last_Value_Attribute => null; - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Stable_Attribute @@ -235,10 +235,10 @@ package body Canon is (Get_Name (Expr), Sensitivity_List, Is_Target); when Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_File_Declaration => null; @@ -459,6 +459,7 @@ package body Canon is (Callees_List : Iir_List; Sensitivity_List : Iir_List) is Callee : Iir; + Bod : Iir; begin -- LRM08 11.3 -- Moreover, for each subprogram for which the process is a parent @@ -477,14 +478,20 @@ package body Canon is Set_Seen_Flag (Callee, True); case Get_All_Sensitized_State (Callee) is when Read_Signal => + Bod := Get_Subprogram_Body (Callee); + + -- Extract sensitivity from signals read in the body. + -- FIXME: what about signals read during in declarations ? Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain - (Get_Subprogram_Body (Callee)), - Sensitivity_List); + (Get_Sequential_Statement_Chain (Bod), Sensitivity_List); + + -- Extract sensitivity from subprograms called. Canon_Extract_Sensitivity_From_Callees - (Get_Callees_List (Callee), Sensitivity_List); + (Get_Callees_List (Bod), Sensitivity_List); + when No_Signal => null; + when Unknown | Invalid_Signal => raise Internal_Error; end case; @@ -499,10 +506,15 @@ package body Canon is Res : Iir_List; begin Res := Create_Iir_List; + + -- Signals read by statements. + -- FIXME: justify why signals read in declarations don't care. Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (Proc), Res); - Canon_Extract_Sensitivity_From_Callees - (Get_Callees_List (Proc), Res); + + -- Signals read indirectly by subprograms called. + Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Proc), Res); + Set_Seen_Flag (Proc, True); Clear_Seen_Flag (Proc); return Res; @@ -717,16 +729,16 @@ package body Canon is | Iir_Kind_Instance_Name_Attribute => null; - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration => null; @@ -798,9 +810,7 @@ package body Canon is begin -- No argument, so return now. if Interface_Chain = Null_Iir then - if Association_Chain /= Null_Iir then - raise Internal_Error; - end if; + pragma Assert (Association_Chain = Null_Iir); return Null_Iir; end if; @@ -842,8 +852,10 @@ package body Canon is end if; when Iir_Kind_Association_Element_By_Individual => Found := True; + when Iir_Kind_Association_Element_Package => + goto Done; when others => - Error_Kind ("canon_association_list", Assoc_El); + Error_Kind ("canon_association_chain", Assoc_El); end case; elsif Found then -- No more associations. @@ -2621,11 +2633,17 @@ package body Canon is Canon_Declarations (Unit, El, Null_Iir); Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); when Iir_Kind_Package_Instantiation_Declaration => - Set_Generic_Map_Aspect_Chain - (El, - Canon_Association_Chain_And_Actuals - (Get_Generic_Chain (El), - Get_Generic_Map_Aspect_Chain (El), El)); + declare + Pkg : constant Iir := + Get_Named_Entity (Get_Uninstantiated_Package_Name (El)); + Hdr : constant Iir := Get_Package_Header (Pkg); + begin + Set_Generic_Map_Aspect_Chain + (El, + Canon_Association_Chain_And_Actuals + (Get_Generic_Chain (Hdr), + Get_Generic_Map_Aspect_Chain (El), El)); + end; when others => Error_Kind ("canonicalize2", El); end case; diff --git a/disp_vhdl.adb b/disp_vhdl.adb index 018db27..eb7a44b 100644 --- a/disp_vhdl.adb +++ b/disp_vhdl.adb @@ -171,10 +171,10 @@ package body Disp_Vhdl is when Iir_Kind_Component_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration @@ -276,7 +276,7 @@ package body Disp_Vhdl is | Iir_Kind_Unit_Declaration | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kinds_Interface_Declaration + | Iir_Kinds_Interface_Object_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration @@ -1025,13 +1025,13 @@ package body Disp_Vhdl is begin if (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Class) /= 0 then case Get_Kind (Inter) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Put ("signal "); - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => Put ("variable "); - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => Put ("constant "); - when Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_File_Declaration => Put ("file "); when others => Error_Kind ("disp_interface_class", Inter); @@ -1054,7 +1054,7 @@ package body Disp_Vhdl is else Disp_Subtype_Indication (Get_Subtype_Indication (Inter)); end if; - if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then Disp_Signal_Kind (Get_Signal_Kind (Inter)); end if; if Default /= Null_Iir then @@ -2536,15 +2536,15 @@ package body Disp_Vhdl is when Iir_Kind_Element_Declaration => Disp_Name_Of (Expr); - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Iterator_Declaration => Disp_Name_Of (Expr); return; @@ -2949,7 +2949,7 @@ package body Disp_Vhdl is Put ("package "); Disp_Identifier (Decl); Put_Line (" is new "); - Disp_Name (Get_Uninstantiated_Name (Decl)); + Disp_Name (Get_Uninstantiated_Package_Name (Decl)); Put (" "); Disp_Generic_Map_Aspect (Decl); Put_Line (";"); @@ -3153,7 +3153,7 @@ package body Disp_Vhdl is Disp_Concurrent_Conditional_Signal_Assignment (An_Iir); when Iir_Kinds_Dyadic_Operator => Disp_Dyadic_Operator (An_Iir); - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Object_Alias_Declaration => Disp_Name_Of (An_Iir); diff --git a/errorout.adb b/errorout.adb index 4dde456..af6977d 100644 --- a/errorout.adb +++ b/errorout.adb @@ -419,7 +419,8 @@ package body Errorout is return "open association element"; when Iir_Kind_Association_Element_By_Individual => return "individual association element"; - when Iir_Kind_Association_Element_By_Expression => + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_Package => return "association element"; when Iir_Kind_Overload_List => return "overloaded name or expression"; @@ -527,7 +528,7 @@ package body Errorout is when Iir_Kind_Psl_Expression => return "PSL instantiation"; - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => if Get_Parent (Node) = Null_Iir then -- For constant interface of predefined operator. return "anonymous interface"; @@ -540,7 +541,7 @@ package body Errorout is when others => return Disp_Identifier (Node, "constant interface"); end case; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => case Get_Kind (Get_Parent (Node)) is when Iir_Kind_Entity_Declaration | Iir_Kind_Block_Statement @@ -549,10 +550,12 @@ package body Errorout is when others => return Disp_Identifier (Node, "signal interface"); end case; - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => return Disp_Identifier (Node, "variable interface"); - when Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_File_Declaration => return Disp_Identifier (Node, "file interface"); + when Iir_Kind_Interface_Package_Declaration => + return Disp_Identifier (Node, "package interface"); when Iir_Kind_Signal_Declaration => return Disp_Identifier (Node, "signal"); when Iir_Kind_Variable_Declaration => diff --git a/evaluation.adb b/evaluation.adb index dd16b22..8279e14 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -89,23 +89,16 @@ package body Evaluation is function Build_Enumeration_Constant (Val : Iir_Index32; Origin : Iir) return Iir_Enumeration_Literal is + Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); + Enum_List : constant Iir_List := + Get_Enumeration_Literal_List (Enum_Type); + Lit : constant Iir_Enumeration_Literal := + Get_Nth_Element (Enum_List, Integer (Val)); Res : Iir_Enumeration_Literal; - Enum_Type : Iir; - Enum_List : Iir_List; - Lit : Iir_Enumeration_Literal; begin - Enum_Type := Get_Base_Type (Get_Type (Origin)); - Enum_List := Get_Enumeration_Literal_List (Enum_Type); - Lit := Get_Nth_Element (Enum_List, Integer (Val)); - - Res := Create_Iir (Iir_Kind_Enumeration_Literal); - Set_Identifier (Res, Get_Identifier (Lit)); + Res := Copy_Enumeration_Literal (Lit); Location_Copy (Res, Origin); - Set_Enum_Pos (Res, Iir_Int32 (Val)); - Set_Type (Res, Get_Type (Origin)); Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - Set_Enumeration_Decl (Res, Lit); return Res; end Build_Enumeration_Constant; @@ -3015,14 +3008,14 @@ package body Evaluation is -- path, as appropriate, will not contain a local item name. case Get_Kind (Prefix) is when Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration => Path_Add_Element (Get_Parent (Prefix), Is_Instance); diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb index c86f1db..453eeaa 100644 --- a/ieee-vital_timing.adb +++ b/ieee-vital_timing.adb @@ -231,7 +231,7 @@ package body Ieee.Vital_Timing is end Check_Level0_Attribute_Specification; procedure Check_Entity_Port_Declaration - (Decl : Iir_Signal_Interface_Declaration) + (Decl : Iir_Interface_Signal_Declaration) is use Name_Table; @@ -796,7 +796,7 @@ package body Ieee.Vital_Timing is end Check_Vital_Delay_Type; function Check_Timing_Generic_Prefix - (Decl : Iir_Constant_Interface_Declaration; Length : Natural) + (Decl : Iir_Interface_Constant_Declaration; Length : Natural) return Boolean is use Name_Table; @@ -818,7 +818,7 @@ package body Ieee.Vital_Timing is -- <VITALPropagationDelayName> ::= -- TPD_<InputPort>_<OutputPort>[_<SDFSimpleConditionAndOrEdge>] procedure Check_Propagation_Delay_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; Oport : Iir; @@ -845,7 +845,7 @@ package body Ieee.Vital_Timing is -- tsetup procedure Check_Input_Setup_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 7) then @@ -856,7 +856,7 @@ package body Ieee.Vital_Timing is -- thold procedure Check_Input_Hold_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 6) then @@ -867,7 +867,7 @@ package body Ieee.Vital_Timing is -- trecovery procedure Check_Input_Recovery_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 10) then @@ -878,7 +878,7 @@ package body Ieee.Vital_Timing is -- tremoval procedure Check_Input_Removal_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 9) then @@ -889,7 +889,7 @@ package body Ieee.Vital_Timing is -- tperiod procedure Check_Input_Period_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; begin @@ -903,7 +903,7 @@ package body Ieee.Vital_Timing is -- tpw procedure Check_Pulse_Width_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; begin @@ -917,7 +917,7 @@ package body Ieee.Vital_Timing is -- tskew procedure Check_Input_Skew_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Fport : Iir; Sport : Iir; @@ -933,7 +933,7 @@ package body Ieee.Vital_Timing is -- tncsetup procedure Check_No_Change_Setup_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 9) then @@ -944,7 +944,7 @@ package body Ieee.Vital_Timing is -- tnchold procedure Check_No_Change_Hold_Time_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is begin if not Check_Timing_Generic_Prefix (Decl, 8) then @@ -955,7 +955,7 @@ package body Ieee.Vital_Timing is -- tipd procedure Check_Interconnect_Path_Delay_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; begin @@ -969,7 +969,7 @@ package body Ieee.Vital_Timing is -- tdevice procedure Check_Device_Delay_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Oport : Iir; pragma Unreferenced (Oport); @@ -995,7 +995,7 @@ package body Ieee.Vital_Timing is -- tisd procedure Check_Internal_Signal_Delay_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; Cport : Iir; @@ -1012,7 +1012,7 @@ package body Ieee.Vital_Timing is -- tbpd procedure Check_Biased_Propagation_Delay_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Iport : Iir; Oport : Iir; @@ -1082,7 +1082,7 @@ package body Ieee.Vital_Timing is -- ticd procedure Check_Internal_Clock_Delay_Generic_Name - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is Cport : Iir; P_Start : Natural; @@ -1168,7 +1168,7 @@ package body Ieee.Vital_Timing is end Check_Internal_Clock_Delay_Generic_Name; procedure Check_Entity_Generic_Declaration - (Decl : Iir_Constant_Interface_Declaration) + (Decl : Iir_Interface_Constant_Declaration) is use Name_Table; Id : Name_Id; @@ -242,6 +242,7 @@ package body Iirs is | Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package | Iir_Kind_Choice_By_Others | Iir_Kind_Choice_By_Expression | Iir_Kind_Choice_By_Range @@ -291,8 +292,6 @@ package body Iirs is | Iir_Kind_Element_Declaration | Iir_Kind_Non_Object_Alias_Declaration | Iir_Kind_Terminal_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator @@ -437,16 +436,19 @@ package body Iirs is | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body | Iir_Kind_File_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -3225,19 +3227,19 @@ package body Iirs is Set_Field7 (Target, Header); end Set_Block_Header; - function Get_Uninstantiated_Name (Inst : Iir) return Iir is + function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir is begin pragma Assert (Inst /= Null_Iir); - pragma Assert (Has_Uninstantiated_Name (Get_Kind (Inst))); + pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst))); return Get_Field5 (Inst); - end Get_Uninstantiated_Name; + end Get_Uninstantiated_Package_Name; - procedure Set_Uninstantiated_Name (Inst : Iir; Name : Iir) is + procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir) is begin pragma Assert (Inst /= Null_Iir); - pragma Assert (Has_Uninstantiated_Name (Get_Kind (Inst))); + pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst))); Set_Field5 (Inst, Name); - end Set_Uninstantiated_Name; + end Set_Uninstantiated_Package_Name; function Get_Generate_Block_Configuration (Target : Iir) return Iir is begin @@ -3689,6 +3691,20 @@ package body Iirs is Set_Field3 (Target, Atype); end Set_Actual_Type; + function Get_Associated_Interface (Assoc : Iir) return Iir is + begin + pragma Assert (Assoc /= Null_Iir); + pragma Assert (Has_Associated_Interface (Get_Kind (Assoc))); + return Get_Field4 (Assoc); + end Get_Associated_Interface; + + procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir) is + begin + pragma Assert (Assoc /= Null_Iir); + pragma Assert (Has_Associated_Interface (Get_Kind (Assoc))); + Set_Field4 (Assoc, Inter); + end Set_Associated_Interface; + function Get_Association_Chain (Target : Iir) return Iir is begin pragma Assert (Target /= Null_Iir); @@ -383,6 +383,7 @@ package Iirs is -- Iir_Kind_Association_Element_By_Expression (Short) -- Iir_Kind_Association_Element_Open (Short) -- Iir_Kind_Association_Element_By_Individual (Short) + -- Iir_Kind_Association_Element_Package (Short) -- These are used for association element of an association list with -- an interface (ie subprogram call, port map, generic map). -- @@ -391,6 +392,7 @@ package Iirs is -- Get/Set_Chain (Field2) -- -- Only for Iir_Kind_Association_Element_By_Expression: + -- Only for Iir_Kind_Association_Element_Package: -- Get/Set_Actual (Field3) -- -- Only for Iir_Kind_Association_Element_By_Individual: @@ -399,6 +401,9 @@ package Iirs is -- Only for Iir_Kind_Association_Element_By_Individual: -- Get/Set_Individual_Association_Chain (Field4) -- + -- Only for Iir_Kind_Association_Element_Package: + -- Get/Set_Associated_Interface (Field4) + -- -- A function call or a type conversion for the association. -- FIXME: should be a name ? -- Only for Iir_Kind_Association_Element_By_Expression: @@ -842,7 +847,7 @@ package Iirs is -- -- Get/Set_Attribute_Value_Chain (Field4) -- - -- Get/Set_Uninstantiated_Name (Field5) + -- Get/Set_Uninstantiated_Package_Name (Field5) -- -- Get/Set_Generic_Chain (Field6) -- @@ -1072,10 +1077,10 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) - -- Iir_Kind_Signal_Interface_Declaration (Medium) - -- Iir_Kind_Constant_Interface_Declaration (Medium) - -- Iir_Kind_Variable_Interface_Declaration (Medium) - -- Iir_Kind_File_Interface_Declaration (Medium) + -- Iir_Kind_Interface_Signal_Declaration (Medium) + -- Iir_Kind_Interface_Constant_Declaration (Medium) + -- Iir_Kind_Interface_Variable_Declaration (Medium) + -- Iir_Kind_Interface_File_Declaration (Medium) -- -- Get/Set the parent of an interface declaration. -- The parent is an entity declaration, a subprogram specification, a @@ -1095,20 +1100,20 @@ package Iirs is -- -- Get/Set_Subtype_Indication (Field5) -- - -- Must always be null_iir for iir_kind_file_interface_declaration. + -- Must always be null_iir for iir_kind_interface_file_declaration. -- Get/Set_Default_Value (Field6) -- -- Get/Set_Mode (Odigit1) -- -- Get/Set_Lexical_Layout (Odigit2) -- - -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Has_Disconnect_Flag (Flag1) -- - -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Has_Active_Flag (Flag2) -- - -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Open_Flag (Flag3) -- -- Get/Set_Visible_Flag (Flag4) @@ -1123,9 +1128,29 @@ package Iirs is -- -- Get/Set_Name_Staticness (State2) -- - -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Signal_Kind (State3) + -- Iir_Kind_Interface_Package_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Uninstantiated_Package_Name (Field5) + -- + -- Get/Set_Generic_Chain (Field6) + -- + -- Get/Set_Generic_Map_Aspect_Chain (Field8) + -- + -- Get/Set_Visible_Flag (Flag4) + -- Iir_Kind_Function_Declaration (Medium) -- Iir_Kind_Procedure_Declaration (Medium) -- @@ -1173,8 +1198,6 @@ package Iirs is -- -- Get/Set_Generic_Chain (Field6) -- - -- Get/Set_Callees_List (Field7) - -- -- --Get/Set_Generic_Map_Aspect_Chain (Field8) -- -- Get/Set_Return_Type_Mark (Field8) @@ -1219,8 +1242,8 @@ package Iirs is -- -- Get/Set_All_Sensitized_State (State3) - -- Iir_Kind_Function_Body (Short) - -- Iir_Kind_Procedure_Body (Short) + -- Iir_Kind_Function_Body (Medium) + -- Iir_Kind_Procedure_Body (Medium) -- -- LRM08 4.3 Subprogram bodies -- @@ -1248,6 +1271,8 @@ package Iirs is -- -- Get/Set_Sequential_Statement_Chain (Field5) -- + -- Get/Set_Callees_List (Field7) + -- -- Get/Set_End_Has_Reserved_Id (Flag8) -- -- Get/Set_End_Has_Identifier (Flag9) @@ -1277,8 +1302,6 @@ package Iirs is -- -- Get/Set_Generic_Chain (Field6) -- - -- Get/Set_Callees_List (Field7) - -- -- Get/Set_Generic_Map_Aspect_Chain (Field8) -- -- Get/Set_Implicit_Definition (Field9) @@ -3429,6 +3452,7 @@ package Iirs is Iir_Kind_Association_Element_By_Expression, Iir_Kind_Association_Element_By_Individual, Iir_Kind_Association_Element_Open, + Iir_Kind_Association_Element_Package, Iir_Kind_Choice_By_Others, Iir_Kind_Choice_By_Expression, Iir_Kind_Choice_By_Range, @@ -3528,10 +3552,11 @@ package Iirs is Iir_Kind_Variable_Declaration, -- object Iir_Kind_Constant_Declaration, -- object Iir_Kind_Iterator_Declaration, -- object - Iir_Kind_Constant_Interface_Declaration, -- object, interface - Iir_Kind_Variable_Interface_Declaration, -- object, interface - Iir_Kind_Signal_Interface_Declaration, -- object, interface - Iir_Kind_File_Interface_Declaration, -- object, interface + Iir_Kind_Interface_Constant_Declaration, -- object, interface + Iir_Kind_Interface_Variable_Declaration, -- object, interface + Iir_Kind_Interface_Signal_Declaration, -- object, interface + Iir_Kind_Interface_File_Declaration, -- object, interface + Iir_Kind_Interface_Package_Declaration, -- Expressions. Iir_Kind_Identity_Operator, @@ -4076,6 +4101,15 @@ package Iirs is type Iir_Constraint is (Unconstrained, Partially_Constrained, Fully_Constrained); + -- The kind of an inteface list. + type Interface_Kind_Type is (Generic_Interface_List, + Port_Interface_List, + Procedure_Parameter_Interface_List, + Function_Parameter_Interface_List); + subtype Parameter_Interface_List is Interface_Kind_Type range + Procedure_Parameter_Interface_List .. + Function_Parameter_Interface_List; + --------------- -- subranges -- --------------- @@ -4270,11 +4304,11 @@ package Iirs is Iir_Kind_Sensitized_Process_Statement .. Iir_Kind_Process_Statement; - subtype Iir_Kinds_Interface_Declaration is Iir_Kind range - Iir_Kind_Constant_Interface_Declaration .. - --Iir_Kind_Variable_Interface_Declaration - --Iir_Kind_Signal_Interface_Declaration - Iir_Kind_File_Interface_Declaration; + subtype Iir_Kinds_Interface_Object_Declaration is Iir_Kind range + Iir_Kind_Interface_Constant_Declaration .. + --Iir_Kind_Interface_Variable_Declaration + --Iir_Kind_Interface_Signal_Declaration + Iir_Kind_Interface_File_Declaration; subtype Iir_Kinds_Object_Declaration is Iir_Kind range Iir_Kind_Object_Alias_Declaration .. @@ -4284,10 +4318,10 @@ package Iirs is --Iir_Kind_Variable_Declaration --Iir_Kind_Constant_Declaration --Iir_Kind_Iterator_Declaration - --Iir_Kind_Constant_Interface_Declaration - --Iir_Kind_Variable_Interface_Declaration - --Iir_Kind_Signal_Interface_Declaration - Iir_Kind_File_Interface_Declaration; + --Iir_Kind_Interface_Constant_Declaration + --Iir_Kind_Interface_Variable_Declaration + --Iir_Kind_Interface_Signal_Declaration + Iir_Kind_Interface_File_Declaration; subtype Iir_Kinds_Branch_Quantity_Declaration is Iir_Kind range Iir_Kind_Across_Quantity_Declaration .. @@ -4305,10 +4339,10 @@ package Iirs is --Iir_Kind_Variable_Declaration --Iir_Kind_Constant_Declaration --Iir_Kind_Iterator_Declaration - --Iir_Kind_Constant_Interface_Declaration - --Iir_Kind_Variable_Interface_Declaration - --Iir_Kind_Signal_Interface_Declaration - Iir_Kind_File_Interface_Declaration; + --Iir_Kind_Interface_Constant_Declaration + --Iir_Kind_Interface_Variable_Declaration + --Iir_Kind_Interface_Signal_Declaration + Iir_Kind_Interface_File_Declaration; subtype Iir_Kinds_Association_Element is Iir_Kind range Iir_Kind_Association_Element_By_Expression .. @@ -4515,10 +4549,10 @@ package Iirs is --Iir_Kind_Variable_Declaration --Iir_Kind_Constant_Declaration --Iir_Kind_Iterator_Declaration - --Iir_Kind_Constant_Interface_Declaration - --Iir_Kind_Variable_Interface_Declaration - --Iir_Kind_Signal_Interface_Declaration - Iir_Kind_File_Interface_Declaration; + --Iir_Kind_Interface_Constant_Declaration + --Iir_Kind_Interface_Variable_Declaration + --Iir_Kind_Interface_Signal_Declaration + Iir_Kind_Interface_File_Declaration; ------------------------------------- -- Types and subtypes declarations -- @@ -4760,7 +4794,7 @@ package Iirs is subtype Iir_Architecture_Body is Iir; - subtype Iir_Signal_Interface_Declaration is Iir; + subtype Iir_Interface_Signal_Declaration is Iir; subtype Iir_Configuration_Declaration is Iir; @@ -4793,11 +4827,11 @@ package Iirs is subtype Iir_Iterator_Declaration is Iir; - subtype Iir_Constant_Interface_Declaration is Iir; + subtype Iir_Interface_Constant_Declaration is Iir; - subtype Iir_Variable_Interface_Declaration is Iir; + subtype Iir_Interface_Variable_Declaration is Iir; - subtype Iir_File_Interface_Declaration is Iir; + subtype Iir_Interface_File_Declaration is Iir; subtype Iir_Guard_Signal_Declaration is Iir; @@ -5736,7 +5770,7 @@ package Iirs is -- from this list, since the purpose of this list is to correctly set -- flags for side effects (purity_state, wait_state). -- Can return null_iir if there is no subprogram called. - -- Field: Field7 (uc) + -- Field: Field7 Of_Ref (uc) function Get_Callees_List (Proc : Iir) return Iir_List; procedure Set_Callees_List (Proc : Iir; List : Iir_List); @@ -5937,8 +5971,8 @@ package Iirs is procedure Set_Block_Header (Target : Iir; Header : Iir); -- Field: Field5 - function Get_Uninstantiated_Name (Inst : Iir) return Iir; - procedure Set_Uninstantiated_Name (Inst : Iir; Name : Iir); + function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir; + procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir); -- Get/Set the block_configuration (there may be several -- block_configuration through the use of prev_configuration singly linked @@ -6098,6 +6132,11 @@ package Iirs is function Get_Actual_Type (Target : Iir) return Iir; procedure Set_Actual_Type (Target : Iir; Atype : Iir); + -- Interface for a package association. + -- Field: Field4 Ref + function Get_Associated_Interface (Assoc : Iir) return Iir; + procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir); + -- List of individual associations for association_element_by_individual. -- Associations for parenthesis_name. -- Field: Field2 Chain diff --git a/iirs_utils.adb b/iirs_utils.adb index 172b0c3..52c1ee8 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -149,14 +149,14 @@ package body Iirs_Utils is loop case Get_Kind (Adecl) is when Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration => + | Iir_Kind_Interface_Variable_Declaration => return Adecl; when Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration => return Adecl; when Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => return Adecl; when Iir_Kind_Object_Alias_Declaration => -- LRM 4.3.3.1 Object Aliases @@ -190,14 +190,14 @@ package body Iirs_Utils is loop case Get_Kind (Adecl) is when Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Iterator_Declaration => return Adecl; when Iir_Kind_Object_Alias_Declaration => @@ -249,7 +249,7 @@ package body Iirs_Utils is case Get_Kind (Formal) is when Iir_Kind_Simple_Name => return Get_Named_Entity (Formal); - when Iir_Kinds_Interface_Declaration => + when Iir_Kinds_Interface_Object_Declaration => return Formal; when Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name @@ -408,21 +408,38 @@ package body Iirs_Utils is return String (Ptr (1 .. Len)); end Image_String_Lit; + function Copy_Enumeration_Literal (Lit : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Enumeration_Literal); + Set_Identifier (Res, Get_Identifier (Lit)); + Location_Copy (Res, Lit); + Set_Parent (Res, Get_Parent (Lit)); + Set_Type (Res, Get_Type (Lit)); + Set_Enum_Pos (Res, Get_Enum_Pos (Lit)); + Set_Expr_Staticness (Res, Locally); + Set_Enumeration_Decl (Res, Lit); + return Res; + end Copy_Enumeration_Literal; + procedure Create_Range_Constraint_For_Enumeration_Type (Def : Iir_Enumeration_Type_Definition) is Range_Expr : Iir_Range_Expression; - Literal_List: Iir_List; + Literal_List : constant Iir_List := Get_Enumeration_Literal_List (Def); begin - Literal_List := Get_Enumeration_Literal_List (Def); - -- Create a constraint. Range_Expr := Create_Iir (Iir_Kind_Range_Expression); Location_Copy (Range_Expr, Def); Set_Type (Range_Expr, Def); Set_Direction (Range_Expr, Iir_To); - Set_Left_Limit (Range_Expr, Get_First_Element (Literal_List)); - Set_Right_Limit (Range_Expr, Get_Last_Element (Literal_List)); + Set_Left_Limit + (Range_Expr, + Copy_Enumeration_Literal (Get_First_Element (Literal_List))); + Set_Right_Limit + (Range_Expr, + Copy_Enumeration_Literal (Get_Last_Element (Literal_List))); Set_Expr_Staticness (Range_Expr, Locally); Set_Range_Constraint (Def, Range_Expr); end Create_Range_Constraint_For_Enumeration_Type; @@ -492,9 +509,9 @@ package body Iirs_Utils is return; when Iir_Kind_Selected_Name => Free_Recursive (Get_Prefix (N)); - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration => Free_Recursive (Get_Type (N)); Free_Recursive (Get_Default_Value (N)); when Iir_Kind_Range_Expression => @@ -557,6 +574,20 @@ package body Iirs_Utils is end loop; end Mark_Subprogram_Used; + function Get_Callees_List_Holder (Subprg : Iir) return Iir is + begin + case Get_Kind (Subprg) is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + return Get_Subprogram_Body (Subprg); + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return Subprg; + when others => + Error_Kind ("get_callees_list_holder", Subprg); + end case; + end Get_Callees_List_Holder; + procedure Clear_Seen_Flag (Top : Iir) is Callees_List : Iir_Callees_List; @@ -564,7 +595,7 @@ package body Iirs_Utils is begin if Get_Seen_Flag (Top) then Set_Seen_Flag (Top, False); - Callees_List := Get_Callees_List (Top); + Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top)); if Callees_List /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (Callees_List, I); @@ -1040,7 +1071,7 @@ package body Iirs_Utils is Adecl := Get_Object_Prefix (Name, True); case Get_Kind (Adecl) 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 => return True; diff --git a/iirs_utils.ads b/iirs_utils.ads index e77e572..a588ab8 100644 --- a/iirs_utils.ads +++ b/iirs_utils.ads @@ -63,6 +63,9 @@ package Iirs_Utils is -- an interface, even if the formal is a name. function Get_Association_Interface (Assoc : Iir) return Iir; + -- Duplicate enumeration literal LIT. + function Copy_Enumeration_Literal (Lit : Iir) return Iir; + -- Make TARGETS depends on UNIT. -- UNIT must be either a design unit or a entity_aspect_entity. procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); @@ -89,6 +92,10 @@ package Iirs_Utils is procedure Create_Range_Constraint_For_Enumeration_Type (Def : Iir_Enumeration_Type_Definition); + -- Return the node containing the Callees_List (ie the subprogram body if + -- SUBPRG is a subprogram spec, SUBPRG if SUBPRG is a process). + function Get_Callees_List_Holder (Subprg : Iir) return Iir; + -- Clear flag of TOP and all of its callees. procedure Clear_Seen_Flag (Top : Iir); diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index ab29cfb..8979f24 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -57,9 +57,9 @@ ieee2008/numeric_std.vhdl ieee2008/numeric_std-body.vhdl \ ieee2008/numeric_std_unsigned.vhdl ieee2008/numeric_std_unsigned-body.vhdl \ ieee2008/fixed_float_types.vhdl \ ieee2008/fixed_generic_pkg.vhdl ieee2008/fixed_generic_pkg-body.vhdl \ -ieee2008/fixed_pkg.vhdl -#ieee2008/float_generic_pkg.vhdl ieee2008/float_generic_pkg-body.vhdl \ -#ieee2008/float_pkg.vhdl +ieee2008/fixed_pkg.vhdl \ +ieee2008/float_generic_pkg.vhdl ieee2008/float_generic_pkg-body.vhdl \ +ieee2008/float_pkg.vhdl STD87_BSRCS := $(STD_SRCS:.vhdl=.v87) STD93_BSRCS := $(STD_SRCS:.vhdl=.v93) diff --git a/libraries/ieee2008/float_generic_pkg-body.vhdl b/libraries/ieee2008/float_generic_pkg-body.vhdl index 6354546..2100f4a 100644 --- a/libraries/ieee2008/float_generic_pkg-body.vhdl +++ b/libraries/ieee2008/float_generic_pkg-body.vhdl @@ -370,12 +370,13 @@ package body float_generic_pkg is arg : UNRESOLVED_float) -- fp vector return STD_ULOGIC_VECTOR is + subtype result_subtype is STD_ULOGIC_VECTOR (arg'length-1 downto 0); variable result : STD_ULOGIC_VECTOR (arg'length-1 downto 0); begin -- function to_std_ulogic_vector if arg'length < 1 then return NSLV; end if; - result := STD_ULOGIC_VECTOR (arg); + result := result_subtype (arg); return result; end function to_sulv; @@ -2739,7 +2740,7 @@ package body float_generic_pkg is -- to_float (unsigned) function to_float ( - arg : UNSIGNED; + arg : UNRESOLVED_UNSIGNED; constant exponent_width : NATURAL := float_exponent_width; -- length of FP output exponent constant fraction_width : NATURAL := float_fraction_width; -- length of FP output fraction constant round_style : round_type := float_round_style) -- rounding option @@ -2764,7 +2765,7 @@ package body float_generic_pkg is -- to_float (signed) function to_float ( - arg : SIGNED; + arg : UNRESOLVED_SIGNED; constant exponent_width : NATURAL := float_exponent_width; -- length of FP output exponent constant fraction_width : NATURAL := float_fraction_width; -- length of FP output fraction constant round_style : round_type := float_round_style) -- rounding option @@ -5073,7 +5074,8 @@ package body float_generic_pkg is variable c : CHARACTER; begin while L /= null and L.all'length /= 0 loop - if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then + c := l (l'left); + if (c = ' ' or c = NBSP or c = HT) then read (l, c, readOk); else exit; @@ -281,50 +281,11 @@ package Nodes is procedure Initialize; private type Node_Record (Format : Format_Type := Format_Short) is record - - -- Usages of Flag1: - -- seen_flag for iir_kind_process_statement - -- seen_flag for iir_kind_sensitized_process_statement - -- seen_flag for iir_kinds_procedure_specification - -- seen_flag for iir_kinds_function_specification - -- seen_flag for iir_kind_design_file - -- deferred_declaration_flag for iir_kind_constant_declaration - -- loaded_flag for iir_kind_design_unit - -- resolved_flag for iir_kinds_type_definition - -- need_body for iir_kind_package_declaration - -- whole_association_flag for iir_kind_association_element_by_expression - -- has_disconnect_flag for iir_kind_signal_declaration Flag1 : Boolean := False; - - -- Usages of Flag2: - -- pure_flag for iir_kinds_function_specification - -- passive_flag for iir_kinds_process_statement - -- shared_flag for iir_kind_variable_declaration - -- aggr_others_flag for iir_kind_aggregate_info - -- signal_type_flag for iir_kinds_type_definition Flag2 : Boolean := False; - - -- Usages of Flag3: - -- (postponed_flag for iir_kinds_process_statement) - -- elab_flag for iir_kind_design_file - -- elab_flag for iir_kind_design_unit - -- dynamic_flag for iir_kind_aggregate_info - -- text_file_flag for iir_kind_file_type_definition - -- foreign_flag for iir_kind_architecture_declaration - -- foreign_flag for iir_kinds_function_specification - -- foreign_flag for iir_kinds_procedure_specification Flag3 : Boolean := False; - - -- Usages of Flag4: - -- visible_flag for iir_kind_type_declaration - -- aggr_named_flag for iir_kind_aggregate_info Flag4 : Boolean := False; - - -- Usages of Flag5: - -- is_within_flag for named entities Flag5 : Boolean := False; - - -- Usages of Flag6: Flag6 : Boolean := False; -- Kind field use 8 bits. @@ -336,512 +297,26 @@ private Kind : Kind_Type; - -- expr_staticness for iir_kind_string_literal - -- expr_staticness for iir_kind_bit_string_literal - -- expr_staticness for iir_kind_integer_literal - -- expr_staticness for iir_kind_floating_point_literal - -- expr_staticness for iir_kind_physical_int_literal - -- expr_staticness for iir_kind_physical_fp_literal - -- expr_staticness for iir_kind_enumeration_literal - -- expr_staticness for iir_kind_monadic_operator - -- expr_staticness for iir_kind_dyadic_operator - -- expr_staticness for iir_kinds_name - -- expr_staticness for iir_kinds_alias_declaration - -- expr_staticness for iir_kind_constant_declaration - -- expr_staticness for iir_kind_iterator_declaration - -- expr_staticness for iir_kind_constant_interface_declaration - -- expr_staticness for iir_kind_aggregate - -- expr_staticness for iir_kind_qualified_expression - -- expr_staticness for iir_kind_type_conversion - -- expr_staticness for iir_kind_length_array_attribute - -- expr_staticness for iir_kind_low_type_attribute - -- expr_staticness for iir_kind_high_type_attribute - -- expr_staticness for iir_kind_left_type_attribute - -- expr_staticness for iir_kind_right_type_attribute - -- expr_staticness for iir_kind_pos_attribute - -- expr_staticness for iir_kind_val_attribute - -- expr_staticness for iir_kind_event_attribute - -- expr_staticness for iir_kind_last_value_attribute - -- expr_staticness for iir_kind_last_active_attribute - -- expr_staticness for iir_kind_active_attribute - -- expr_staticness for iir_kind_range_expression - -- expr_staticness for iir_kind_selected_element - -- expr_staticness for iir_kind_function_call - -- expr_staticness for iir_kind_attribute_value - -- expr_staticness for iir_kind_signal_declaration - -- expr_staticness for iir_kind_guard_signal_declaration - -- expr_staticness for iir_kind_variable_declaration - -- expr_staticness for iir_kind_file_declaration - -- expr_staticness for iir_kinds_discrete_type_attribute - -- type_staticness for iir_kinds_type_and_subtype_definition State1 : Bit2_Type := 0; - - -- name_staticness for iir_kinds_name - -- name_staticness for iir_kind_object_alias_declaration - -- name_staticness for iir_kind_selected_element - -- name_staticness for iir_kind_selected_by_all_name - -- choice_staticness for iir_kind_choice_by_range - -- choice_staticness for iir_kind_choice_by_expression State2 : Bit2_Type := 0; - Flag7 : Boolean := False; Flag8 : Boolean := False; Flag9 : Boolean := False; Flag10 : Boolean := False; + Flag11 : Boolean := False; Flag12 : Boolean := False; - - -- 3bits fields (1 -> 3 bits) - -- Usages of odigit1: - -- lexical_layout for iir_kinds_interface_declaration - -- iir_mode Odigit1 : Bit3_Type := 0; - Unused_Odigit2 : Bit3_Type := 0; -- Location. Location: Location_Type := Location_Nil; - -- The parent node. - -- parent for iir_kind_if_statement - -- parent for iir_kind_elsif_statement - -- parent for iir_kind_for_loop_statement - -- parent for iir_kind_while_loop_statement - -- parent for iir_kind_case_statement - -- parent for iir_kind_exit_statement - -- parent for iir_kind_next_statement - -- parent (library_declaration) for iir_kind_design_file - -- parent (design_unit_list) for iir_kind_design_file - -- interface_parent for iir_kind_signal_interface_declaration - -- interface_parent for iir_kind_constant_interface_declaration - -- interface_parent for iir_kind_variable_interface_declaration - -- interface_parent for iir_kind_file_interface_declaration Field0 : Node_Type := Null_Node; - - -- usages of field1: - -- type for iir_kind_character_literal - -- type for iir_kind_type_computed_literal - -- type for iir_kind_integer_literal - -- type for iir_kind_floating_point_literal - -- type for iir_type_declaration. - -- type for iir_subtype_declaration. - -- type for iir_kind_identifier - -- type for iir_kind_string_literal - -- type for iir_kind_bit_string_literal - -- type for iir_kind_base_attribute - -- list_element for iir_kinds_list - -- port_chain for iir_kind_entity_declaration - -- port_chain for iir_kind_component_declaration - -- port_chain for iir_kind_block_header - -- entity for iir_kind_architecture_declaration - -- entity for iir_kind_configuration_declaration - -- entity for iir_kind_entity_aspect_entity - -- package for iir_kind_package_body - -- primary_units(iir_library_unit_list) for iir_kind_library_declaration - -- selected_name for iir_kind_use_clause - -- type_declaration for iir_kinds_type_definition - -- type_definition for iir_kind_signal_declaration - -- type_definition for iir_kind_guard_signal_declaration - -- type_definition for iir_kind_signal_interface_declaration. - -- type_definition for iir_kind_variable_declaration - -- type_definition for iir_kind_variable_interface_declaration. - -- type_definition for iir_kind_constant_declaration - -- type_definition for iir_kind_iterator_declaration - -- type_definition for iir_kind_constant_interface_declaration. - -- type_definition for iir_kind_file_declaration - -- type_definition for iir_kind_file_interface_declaration. - -- type_definition for iir_kind_enumeration_literal - -- type_definition for iir_kind_unit_declaration - -- type_definition for iir_kind_component_port - -- type_definition for iir_kind_element_declaration - -- type_definition for iir_kinds_attribute_declaration - -- type_definition for iir_kinds_attribute - -- type_definition for iir_kinds_name - -- type_definition for iir_kind_return_statement - -- type_definition for iir_kind_aggregate - -- type_definition for iir_kind_physical_int_literal - -- type_definition for iir_kind_physical_fp_literal - -- type_definition for iir_kind_object_alias_declaration - -- type_definition for iir_kind_null_literal - -- type_definition for iir_kind_qualified_expression - -- type_definition for iir_kind_type_conversion - -- type_definition for iir_kind_function_call - -- type_definition for iir_kind_allocator_by_expression - -- type_definition for iir_kind_allocator_by_subtype - -- type_definition for iir_kind_attribute_value - -- type_definition for iir_kind_selected_element - -- type_definition for iir_kind_implicit_dereference. - -- type_definition for iir_kind_disconnection_specification - -- type_definition for iir_kinds_monadic_operator - -- type_definition for iir_kinds_dyadic_operator - -- null_iir for iir_kind_signal_assignment_statement - -- null_iir for iir_kind_variable_assignment_statement - -- we_value for iir_kind_waveform_element - -- condition for iir_kind_conditional_waveform - -- condition for iir_kind_if_statement - -- condition for iir_kind_elsif - -- condition for iir_kind_while_loop_statement - -- condition for iir_kind_next_statement - -- condition for iir_kind_exit_statement - -- design_unit_chain for iir_kind_design_file - -- formal for iir_kinds_association_element - -- iterator_scheme for iir_kind_for_loop_statement - -- associated for iir_kinds_association_by_choice - -- context_items for iir_kind_design_unit - -- design_file_chain for iir_kind_library_declaration - -- proxy for iir_kind_proxy - -- selected_waveform_l for iir_kind_concurrent_selected_signal_assignment - -- block_specification for iir_kind_block_configuration - -- instantiation_list for iir_kind_component_configuration - -- instantiation_list for iir_kind_configuration_specification - -- component_configuration for iir_kind_component_instantiation_statement - -- configuration for iir_kind_entity_aspect_configuration - -- guard_decl for iir_kind_block_statement - -- entity_class_entry_chain for iir_kind_group_template_declaration - -- group_constituent_chain for iir_kind_group_declaration - -- entity_name_list for iir_kind_attribute_specification - -- generate_block_configuration for iir_kind_generate_statement - -- type_declarator for Iir_Kind_Enumeration_Type_Definition - -- type_declarator for Iir_Kind_Enumeration_Subtype_Definition - -- type_declarator for Iir_Kind_Integer_Type_Definition - -- type_declarator for Iir_Kind_Integer_Subtype_Definition - -- type_declarator for Iir_Kind_Floating_Type_Definition - -- type_declarator for Iir_Kind_Floating_Subtype_Definition - -- type_declarator for Iir_Kind_Physical_Type_Definition - -- type_declarator for Iir_Kind_Physical_Subtype_Definition - -- type_declarator for Iir_Kind_Record_Type_Definition - -- type_declarator for Iir_Kind_Record_Subtype_Definition - -- type_declarator for Iir_Kind_Array_Type_Definition - -- type_declarator for Iir_Kind_Array_Subtype_Definition - -- type_declarator for Iir_Kind_Unconstrained_Array_Subtype_Definition - -- type_declarator for Iir_Kind_Access_Type_Definition - -- type_declarator for Iir_Kind_Access_Subtype_Definition - -- type_declarator for Iir_Kind_Incomplete_Type_Definition - -- type_declarator for Iir_Kind_File_Type_Definition - -- return_type for iir_kind_function_specification - -- return_type for iir_kind_function_spec_body - -- return_type for iir_kind_implicit_function_declaration - -- default_entity_aspect for iir_kind_binding_indication - -- sub_aggregate_info for iir_kind_aggregate_info Field1: Node_Type := Null_Node; - - -- usages of field2: - -- concurrent_statement_list for iir_kind_architecture_declaration - -- concurrent_statement_list for iir_kind_block_statement - -- concurrent_statement_list for iir_kind_entity_declaration - -- concurrent_statement_list for iir_kind_generate_statement - -- block_configuration for iir_kind_configuration_declaration - -- block_configuration for iir_kind_component_configuration - -- subprogram_body for iir_kind_function_specification - -- subprogram_body for iir_kind_procedure_specification - -- range_constraint for iir_kind_integer_subtype_definition - -- range_constraint for iir_kind_floating_subtype_definition - -- range_constraint for iir_kind_subtype_definition - -- range_constraint for iir_kind_enumeration_subtype_definition - -- range_constraint for iir_kind_physical_subtype_definition - -- range_constraint for iir_kind_enumeration_type_definition - -- left_limit for iir_kind_range_expression - -- designated_type for iir_kind_access_type_definition - -- index_subtype for iir_array_type_definition - -- index_subtype for iir_array_subtype_definition - -- suffix for iir_kinds_attribute - -- suffix for iir_kind_user_attribute - -- suffix for iir_kind_slice_name - -- selected_element for iir_kind_selected_element - -- parameter for iir_kind_val_attribute - -- parameter for iir_kind_pos_attribute - -- parameter for iir_kind_delayed_attribute - -- parameter for iir_kind_stable_attribute - -- parameter for iir_kind_quiet_attribute - -- parameter for iir_kind_attribute - -- index_list for iir_kind_indexed_name - -- index_list for iir_kind_array_type_definition - -- index_list for iir_kind_array_subtype_definition - -- target for iir_kind_signal_assignment_statement - -- target for iir_kind_variable_assignment_statement - -- time for iir_kind_waveform_element - -- target for iir_kind_concurrent_conditional_signal_assignment - -- target for iir_kind_concurrent_selected_signal_assignment - -- assertion_condition for iir_kind_concurrent_assertion_statement - -- assertion_condition for iir_kind_assertion_statement - -- null_iir for iir_kind_conditional_waveform - -- sequential_statement_chain for iir_kind_if_statement - -- sequential_statement_chain for iir_kind_elsif - -- sequential_statement_chain for iir_kind_sensitized_process_statement - -- sequential_statement_chain for iir_kind_process_statement - -- sequential_statement_chain for iir_kind_for_loop_statement - -- sequential_statement_chain for iir_kind_while_loop_statement - -- sequential_statement_chain for iir_kind_function_Body - -- sequential_statement_chain for iir_kind_function_Spec_Body - -- sequential_statement_chain for iir_kind_procedure_Body - -- sequential_statement_chain for iir_kind_procedure_Spec_Body - -- name for iir_kind_object_alias_declaration - -- name for iir_kind_physical_int_literal - -- name for iir_kind_physical_fp_literal - -- name for iir_kind_association_choice_by_name - -- name for iir_kind_group_declaration - -- default_value for iir_kind_signal_declaration - -- default_value for iir_kind_guard_signal_declaration - -- default_value for iir_kind_variable_declaration - -- default_value for iir_kind_constant_declaration - -- default_value for iir_kind_signal_interface_declaration - -- default_value for iir_kind_variable_interface_declaration - -- default_value for iir_kind_constant_interface_declaration - -- default_value for iir_kind_file_interface_declaration - -- guard_expression for iir_kind_guard_signal_declaration - -- operand for iir_kinds_monadic_operator - -- left for iir_kinds_dyadic_operator - -- actual for iir_kind_association_element_by_expression - -- instantiated_unit for Iir_Kind_Component_Instantiation_Statement - -- parameter_association_chain for iir_kind_function_call - -- parameter_association_chain for iir_kind_procedure_call - -- parameter_association_chain for iir_kind_concurrent_procedure_call_st. - -- library_unit for iir_kind_design_unit - -- multiplier for iir_kind_unit_declaration - -- primary_unit for iir_kind_physical_type_definition - -- condition_clause for iir_kind_wait_statement - -- element_declaration_list for iir_kind_record_type_definition - -- loop for iir_kind_exit_statement - -- loop for iir_kind_next_statement - -- file_logical_name for iir_kind_file_declaration - -- configuration_item_chain for iir_kind_block_configuration - -- architecture for iir_kind_entity_aspect_entity - -- library_declaration for iir_kind_library_clause - -- attribute_designator for iir_kind_attribute_specification - -- attribute_specification for iir_kind_attribute_value - -- signal_list for iir_kind_disconnection_specification - -- generation_scheme for iir_kind_generate_statement - -- incomplete_type_List for iir_kind_incomplete_type_definition - -- file_time_stamp for iir_kind_design_file - -- default_generic_map_aspect_list for iir_kind_binding_indication - -- aggr_low_limit for iir_kind_aggregate_info - -- enumeration_decl for iir_kind_enumeration_literal - -- simple_aggregate_list for iir_kind_simple_aggregate Field2: Node_Type := Null_Node; - - -- Usages of field3: - -- dependence_list for iir_kind_design_unit - -- block_statement for iir_kind_signal_declaration - -- block_statement for iir_kind_guard_signal_declaration - -- subprogram_declaration for iir_kind_function_Spec_Body - -- subprogram_declaration for iir_kind_function_Body - -- subprogram_declaration for iir_kind_Procedure_Spec_Body - -- subprogram_declaration for iir_kind_Procedure_Body - -- body for iir_kind_function_specification - -- body for iir_kind_procedure_specification - -- declaration_list for iir_kind_entity_declaration - -- declaration_list for iir_kind_architecture_declaration - -- declaration_list for iir_kind_configuration_declaration - -- declaration_list for iir_kind_block_statement - -- declaration_list for iir_kind_package_declaration - -- declaration_list for iir_kind_package_body - -- declaration_list for iir_kind_sensitized_process_statement - -- declaration_list for iir_kind_process_statement - -- declaration_list for iir_kind_block_configuration - -- declaration_list for iir_kind_generate_statement - -- enumeration_literal_list for iir_enumeration_type_definition - -- right_limit for iir_kind_range_expression - -- element_subtype for iir_array_type_definition - -- element_subtype for iir_array_subtype_definition - -- report_expression for iir_kind_concurrent_assertion_statement - -- report_expression for iir_kind_assertion_statement - -- report_expression for iir_kind_report_statement - -- waveform_chain for iir_kind_signal_assignment_statement - -- conditional_waveform_chain for iir_kind_conc_conditional_signal_assign - -- waveform_chain for iir_kind_conditional_waveform - -- else_clause for iir_kind_if_statement - -- else_clause for iir_kind_elsif - -- expression of iir_kind_concurrent_selected_signal_assignment - -- expression of iir_kind_variable_assignment_statement - -- prefix for iir_kinds_attribute - -- prefix for iir_kind_indexed_name - -- prefix for iir_kind_slice_name - -- prefix for iir_kind_selected_name - -- prefix for iir_kind_selected_by_all_name - -- prefix for iir_kind_parenthesis_name - -- prefix for iir_kind_selected_element - -- prefix for iir_kind_implicit_dereference - -- port_map_aspect for Iir_Kind_Component_Instantiation_Statement - -- port_map_aspect for Iir_Kind_binding_indication - -- port_map_aspect for Iir_Kind_block_header - -- binding_indication for iir_kind_Component_configuration - -- binding_indication for Iir_Kind_Configuration_specifiation - -- expression for iir_kind_return_statement - -- expression for iir_kind_association_choice_by_expression - -- expression for iir_kind_case_statement - -- expression for iir_kind_qualified_expression - -- expression for iir_kind_type_conversion - -- expression for iir_kind_allocator_by_expression - -- expression for iir_kind_allocator_by_subtype - -- expression for iir_kind_attribute_specification - -- expression for iir_kind_disconnection_specification - -- unit_chain for iir_kind_physical_type_definition - -- timeout_clause for iir_kind_wait_statement - -- file_open_kind for iir_kind_file_declaration - -- designated_entity for iir_kind_attribute_value - -- associated_formal for iir_kinds_association_element - -- deferred_declaration for iir_kind_constant_declaration - -- literal_origin for iir_kind_character_literal - -- literal_origin for iir_kind_string_literal - -- literal_origin for iir_kind_bit_string_literal - -- literal_origin for iir_kind_integer_literal - -- literal_origin for iir_kind_floating_point_literal - -- literal_origin for iir_kind_physical_int_literal - -- literal_origin for iir_kind_physical_fp_literal - -- literal_origin for iir_kind_enumeration_literal - -- analysis_time_stamp for iir_kind_design_file - -- aggr_high_limit for iir_kind_aggregate_info - -- aggregate_info for iir_kind_aggregate - -- implementation for iir_kind_function_call - -- implementation for iir_kind_procedure_call - -- implementation for iir_kind_concurrent_procedure_call_statement - -- implementation for iir_kind_dyadic_operator - -- implementation for iir_kind_monadic_operator Field3: Node_Type := Null_Node; - -- Usages of field4: - -- design_file for iir_kind_design_unit - -- generic_chain for iir_kind_entity_declaration - -- generic_chain for iir_kind_component_declaration - -- generic_chain for iir_kind_block_header - -- base_type for iir_kind_integer_type_definition - -- base_type for iir_kind_integer_subtype_definition - -- base_type for iir_kind_floating_type_definition - -- base_type for iir_kind_floating_subtype_definition - -- base_type for iir_kind_subtype_definition - -- base_type for iir_kind_enumeration_type_definition - -- base_type for iir_kind_enumeration_subtype_definition - -- base_type for iir_kind_array_type_definition - -- base_type for iir_kind_array_subtype_definition - -- base_type for iir_kind_unconstrained_array_subtype_definition - -- base_type for iir_kind_range_attribute - -- base_type for iir_kind_physical_type_definition - -- base_type for iir_kind_physical_subtype_definition - -- base_type for iir_kind_record_type_definition - -- base_type for iir_kind_record_subtype_definition - -- base_type for iir_kind_access_type_definition - -- base_type for iir_kind_access_subtype_definition - -- base_type for iir_kind_incomplete_type_definition - -- base_type for iir_kind_file_type_definition - -- severity_expression for iir_kind_concurrent_assertion_statement - -- severity_expression for iir_kind_assertion_statement - -- severity_expression for iir_kind_report_statement - -- sensitivity_list for iir_kind_sensitized_process_statement - -- sensitivity_list for iir_kind_wait_statement - -- name_value of iir_kind_simple_name - -- association_chain for iir_kind_association_element_by_individual - -- association_chain for iir_kind_parenthesis_name - -- association_choices_list for iir_kind_aggregate - -- association_choices_list for iir_kind_case_statement - -- guard for iir_kind_concurrent_conditional_signal_assignment - -- guard for iir_kind_concurrent_selected_signal_assignment - -- entity_aspect for iir_kind_binding_indication - -- default_binding_indicat for iir_kind_component_instantiation_statement - -- component_name for iir_kind_component_configuration - -- component_name for iir_kind_configuration_specification - -- prev_block_configuration for iir_kind_block_configuration - -- interface_declaration for iir_kind_function_Specification - -- interface_declaration for iir_kind_function_Spec_Body - -- interface_declaration for iir_kind_procedure_Specification - -- interface_declaration for iir_kind_procedure_Spec_Body - -- interface_declaration for iir_kind_implicit_function_declaration - -- interface_declaration for iir_kind_implicit_procedure_declaration - -- subprogram_specification for iir_kind_function_Body - -- subprogram_specification for iir_kind_procedure_Body - -- in_conversion for iir_kind_association_element_by_expression - -- default_configuration for iir_kind_architecture_declaration - -- bit_string_0 for iir_kind_bit_string_literal - -- base_name for iir_kind_object_alias_declaration - -- base_name for iir_kind_signal_declaration - -- base_name for iir_kind_guard_signal_declaration - -- base_name for iir_kind_variable_declaration - -- base_name for iir_kind_file_declaration - -- base_name for iir_kind_constant_declaration - -- base_name for iir_kind_iterator_declaration - -- base_name for iir_kind_slice_name - -- base_name for iir_kind_indexed_name - -- base_name for iir_kind_selected_element - -- base_name for iir_kind_selected_by_all_name - -- base_name for iir_kind_implicit_dereference - -- base_name for iir_kind_attribute_value - -- base_name for iir_kind_function_call - -- block_block_configuration for iir_kind_block_statement - -- right for iir_kinds_dyadic_operator - --Field4: Node_Type := Null_Node; - - -- Usages of field5 (aka nbr1). - -- driver_list for iir_kind_sensitized_process_statement - -- driver_list for iir_kind_process_statement - -- driver_list for iir_kinds_function_specification - -- driver_list for iir_kinds_procedure_specification - -- guard_sensitivity_list for iir_kind_guard_signal_declaration - -- signal_driver for iir_kind_signal_declaration - -- reject_time for iir_kind_concurrent_selected_signal_assignment - -- reject_time for iir_kind_concurrent_conditionnal_signal_assignment - -- reject_time for iir_kind_signal_assignment_statement - -- resolution_function for iir_kind_integer_subtype_definition - -- resolution_function for iir_kind_floating_subtype_definition - -- resolution_function for iir_kind_enumeration_subtype_definition - -- resolution_function for iir_kind_physical_subtype_definition - -- resolution_function for iir_kind_array_subtype_definition - -- resolution_function for iir_kind_unconstrained_array_subtype_definit. - -- resolution_function for iir_kind_record_subtype_definition - -- date for iir_kind_library_declaration - -- date for iir_kind_design_unit - -- generic_map_aspect for Iir_Kind_Component_Instantiation_Statement - -- generic_map_aspect for Iir_Kind_block_header - -- generic_map_aspect for Iir_Kind_binding_indication - -- generation_scheme for iir_kind_generate_statement - -- design_unit for iir_kind_constant_declaration - -- design_unit for iir_kind_entity_declaration - -- design_unit for iir_kind_configuration_declaration - -- design_unit for iir_kind_package_declaration - -- design_unit for iir_kind_body_declaration - -- design_unit for iir_kind_architecture_declaration - -- out_conversion for iir_kind_association_element_by_expression - -- bit_string_1 for iir_kind_bit_string_literal - --Field5: Node_Type := Null_Node; - - -- Usages of Field6: - -- offset for iir_kind_design_unit - -- number of element for iir_kinds_list - -- base for iir_kind_bit_string_literal - -- element_position for iir_kind_element_declaration - -- type_mark for iir_kind_qualified_expression - -- type_mark for iir_kind_file_type_definition - -- type_mark for iir_kind_integer_subtype_definition - -- type_mark for iir_kind_floating_subtype_definition - -- type_mark for iir_kind_enumeration_subtype_definition - -- type_mark for iir_kind_physical_subtype_definition - -- type_mark for iir_kind_access_subtype_definition - -- type_mark for iir_kind_record_subtype_definition - -- type_mark for iir_kind_unconstrained_array_subtype_definition - -- bit_string_base for iir_kind_bit_string_literal - -- default_port_map_aspect_list for iir_kind_binding_indication - - -- Usages of nbr3/field7: - -- line for iir_kind_design_unit - -- max number of elements for iir_kinds_list - -- implicit_definition for iir_kind_implicit_function_declaration - -- implicit_definition for iir_kind_implicit_procedure_declaration - -- block_header for iir_kind_block_statement - -- delay_mechanism for iir_kind_concurrent_selected_signal_assignment - -- delay_mechanism for iir_kind_concurrent_conditionnal_signal_assignment - -- delay_mechanism for iir_kind_signal_assignment_statement - -- value for iir_kind_integer_literal - -- value for iir_kind_enumeration_literal - -- value for iir_kind_unit_declaration - -- value for iir_kind_physical_int_literal - -- fp_value for iir_kind_physical_fp_literal - -- fp_value for iir_kind_floating_point_literal - -- entity_kind for iir_kind_entity_class - -- entity_kind for iir_kind_attribute_specification - -- callees_list for iir_kind_process_declaration - -- callees_list for iir_kind_sensitized_process_declaration - -- library_directory for iir_kind_library_declaration - -- filename for iir_kind_design_file - -- directory for iir_kind_design_file - -- aggr_max_length for iir_kind_aggregate_info case Format is when Format_Short | Format_Medium => diff --git a/nodes_gc.adb b/nodes_gc.adb index 65fe7f2..38966f2 100644 --- a/nodes_gc.adb +++ b/nodes_gc.adb @@ -82,7 +82,7 @@ package body Nodes_GC is end if; case Get_Kind (N) is - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => if Get_Identifier (N) = Null_Identifier then -- Anonymous interfaces are shared by predefined functions. return; diff --git a/nodes_meta.adb b/nodes_meta.adb index c84ff23..3e038f5 100644 --- a/nodes_meta.adb +++ b/nodes_meta.adb @@ -214,7 +214,7 @@ package body Nodes_Meta is Field_Block_Block_Configuration => Type_Iir, Field_Package_Header => Type_Iir, Field_Block_Header => Type_Iir, - Field_Uninstantiated_Name => Type_Iir, + Field_Uninstantiated_Package_Name => Type_Iir, Field_Generate_Block_Configuration => Type_Iir, Field_Generation_Scheme => Type_Iir, Field_Condition => Type_Iir, @@ -247,6 +247,7 @@ package body Nodes_Meta is Field_Index_Subtype => Type_Iir, Field_Parameter => Type_Iir, Field_Actual_Type => Type_Iir, + Field_Associated_Interface => Type_Iir, Field_Association_Chain => Type_Iir, Field_Individual_Association_Chain => Type_Iir, Field_Aggregate_Info => Type_Iir, @@ -704,8 +705,8 @@ package body Nodes_Meta is return "package_header"; when Field_Block_Header => return "block_header"; - when Field_Uninstantiated_Name => - return "uninstantiated_name"; + when Field_Uninstantiated_Package_Name => + return "uninstantiated_package_name"; when Field_Generate_Block_Configuration => return "generate_block_configuration"; when Field_Generation_Scheme => @@ -770,6 +771,8 @@ package body Nodes_Meta is return "parameter"; when Field_Actual_Type => return "actual_type"; + when Field_Associated_Interface => + return "associated_interface"; when Field_Association_Chain => return "association_chain"; when Field_Individual_Association_Chain => @@ -930,6 +933,8 @@ package body Nodes_Meta is return "association_element_by_individual"; when Iir_Kind_Association_Element_Open => return "association_element_open"; + when Iir_Kind_Association_Element_Package => + return "association_element_package"; when Iir_Kind_Choice_By_Others => return "choice_by_others"; when Iir_Kind_Choice_By_Expression => @@ -1100,14 +1105,16 @@ package body Nodes_Meta is return "constant_declaration"; when Iir_Kind_Iterator_Declaration => return "iterator_declaration"; - when Iir_Kind_Constant_Interface_Declaration => - return "constant_interface_declaration"; - when Iir_Kind_Variable_Interface_Declaration => - return "variable_interface_declaration"; - when Iir_Kind_Signal_Interface_Declaration => - return "signal_interface_declaration"; - when Iir_Kind_File_Interface_Declaration => - return "file_interface_declaration"; + when Iir_Kind_Interface_Constant_Declaration => + return "interface_constant_declaration"; + when Iir_Kind_Interface_Variable_Declaration => + return "interface_variable_declaration"; + when Iir_Kind_Interface_Signal_Declaration => + return "interface_signal_declaration"; + when Iir_Kind_Interface_File_Declaration => + return "interface_file_declaration"; + when Iir_Kind_Interface_Package_Declaration => + return "interface_package_declaration"; when Iir_Kind_Identity_Operator => return "identity_operator"; when Iir_Kind_Negation_Operator => @@ -1693,7 +1700,7 @@ package body Nodes_Meta is when Field_Postponed_Flag => return Attr_None; when Field_Callees_List => - return Attr_None; + return Attr_Of_Ref; when Field_Passive_Flag => return Attr_None; when Field_Resolution_Function_Flag => @@ -1762,7 +1769,7 @@ package body Nodes_Meta is return Attr_None; when Field_Block_Header => return Attr_None; - when Field_Uninstantiated_Name => + when Field_Uninstantiated_Package_Name => return Attr_None; when Field_Generate_Block_Configuration => return Attr_None; @@ -1828,6 +1835,8 @@ package body Nodes_Meta is return Attr_None; when Field_Actual_Type => return Attr_None; + when Field_Associated_Interface => + return Attr_Ref; when Field_Association_Chain => return Attr_Chain; when Field_Individual_Association_Chain => @@ -2076,6 +2085,13 @@ package body Nodes_Meta is Field_Artificial_Flag, Field_Formal, Field_Chain, + -- Iir_Kind_Association_Element_Package + Field_Whole_Association_Flag, + Field_Collapse_Signal_Flag, + Field_Formal, + Field_Chain, + Field_Actual, + Field_Associated_Interface, -- Iir_Kind_Choice_By_Others Field_Same_Alternative_Flag, Field_Chain, @@ -2463,7 +2479,7 @@ package body Nodes_Meta is Field_End_Has_Identifier, Field_Declaration_Chain, Field_Attribute_Value_Chain, - Field_Uninstantiated_Name, + Field_Uninstantiated_Package_Name, Field_Generic_Chain, Field_Generic_Map_Aspect_Chain, Field_Parent, @@ -2674,7 +2690,6 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Interface_Declaration_Chain, Field_Generic_Chain, - Field_Callees_List, Field_Return_Type_Mark, Field_Parent, Field_Return_Type, @@ -2694,7 +2709,6 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Interface_Declaration_Chain, Field_Generic_Chain, - Field_Callees_List, Field_Generic_Map_Aspect_Chain, Field_Parent, Field_Return_Type, @@ -2713,7 +2727,6 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Interface_Declaration_Chain, Field_Generic_Chain, - Field_Callees_List, Field_Generic_Map_Aspect_Chain, Field_Parent, Field_Type_Reference, @@ -2736,7 +2749,6 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Interface_Declaration_Chain, Field_Generic_Chain, - Field_Callees_List, Field_Return_Type_Mark, Field_Parent, Field_Subprogram_Body, @@ -2749,6 +2761,7 @@ package body Nodes_Meta is Field_Sequential_Statement_Chain, Field_Parent, Field_Subprogram_Specification, + Field_Callees_List, -- Iir_Kind_Procedure_Body Field_Impure_Depth, Field_End_Has_Reserved_Id, @@ -2758,6 +2771,7 @@ package body Nodes_Meta is Field_Sequential_Statement_Chain, Field_Parent, Field_Subprogram_Specification, + Field_Callees_List, -- Iir_Kind_Object_Alias_Declaration Field_Identifier, Field_Visible_Flag, @@ -2866,7 +2880,7 @@ package body Nodes_Meta is Field_Subtype_Indication, Field_Parent, Field_Type, - -- Iir_Kind_Constant_Interface_Declaration + -- Iir_Kind_Interface_Constant_Declaration Field_Identifier, Field_Visible_Flag, Field_After_Drivers_Flag, @@ -2882,7 +2896,7 @@ package body Nodes_Meta is Field_Default_Value, Field_Parent, Field_Type, - -- Iir_Kind_Variable_Interface_Declaration + -- Iir_Kind_Interface_Variable_Declaration Field_Identifier, Field_Visible_Flag, Field_After_Drivers_Flag, @@ -2898,7 +2912,7 @@ package body Nodes_Meta is Field_Default_Value, Field_Parent, Field_Type, - -- Iir_Kind_Signal_Interface_Declaration + -- Iir_Kind_Interface_Signal_Declaration Field_Identifier, Field_Has_Disconnect_Flag, Field_Has_Active_Flag, @@ -2918,7 +2932,7 @@ package body Nodes_Meta is Field_Default_Value, Field_Parent, Field_Type, - -- Iir_Kind_File_Interface_Declaration + -- Iir_Kind_Interface_File_Declaration Field_Identifier, Field_Visible_Flag, Field_After_Drivers_Flag, @@ -2934,6 +2948,16 @@ package body Nodes_Meta is Field_Default_Value, Field_Parent, Field_Type, + -- Iir_Kind_Interface_Package_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Declaration_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Uninstantiated_Package_Name, + Field_Generic_Chain, + Field_Generic_Map_Aspect_Chain, + Field_Parent, -- Iir_Kind_Identity_Operator Field_Expr_Staticness, Field_Operand, @@ -3276,9 +3300,9 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Sequential_Statement_Chain, Field_Sensitivity_List, - Field_Callees_List, Field_Process_Origin, Field_Parent, + Field_Callees_List, -- Iir_Kind_Process_Statement Field_Label, Field_Seen_Flag, @@ -3295,9 +3319,9 @@ package body Nodes_Meta is Field_Chain, Field_Attribute_Value_Chain, Field_Sequential_Statement_Chain, - Field_Callees_List, Field_Process_Origin, Field_Parent, + Field_Callees_List, -- Iir_Kind_Concurrent_Conditional_Signal_Assignment Field_Delay_Mechanism, Field_Label, @@ -3865,224 +3889,226 @@ package body Nodes_Meta is Iir_Kind_Association_Element_By_Expression => 97, Iir_Kind_Association_Element_By_Individual => 103, Iir_Kind_Association_Element_Open => 108, - Iir_Kind_Choice_By_Others => 113, - Iir_Kind_Choice_By_Expression => 120, - Iir_Kind_Choice_By_Range => 127, - Iir_Kind_Choice_By_None => 132, - Iir_Kind_Choice_By_Name => 138, - Iir_Kind_Entity_Aspect_Entity => 140, - Iir_Kind_Entity_Aspect_Configuration => 141, - Iir_Kind_Entity_Aspect_Open => 141, - Iir_Kind_Block_Configuration => 147, - Iir_Kind_Block_Header => 151, - Iir_Kind_Component_Configuration => 157, - Iir_Kind_Binding_Indication => 163, - Iir_Kind_Entity_Class => 165, - Iir_Kind_Attribute_Value => 173, - Iir_Kind_Signature => 176, - Iir_Kind_Aggregate_Info => 183, - Iir_Kind_Procedure_Call => 187, - Iir_Kind_Record_Element_Constraint => 193, - Iir_Kind_Array_Element_Resolution => 194, - Iir_Kind_Record_Resolution => 195, - Iir_Kind_Record_Element_Resolution => 198, - Iir_Kind_Attribute_Specification => 206, - Iir_Kind_Disconnection_Specification => 211, - Iir_Kind_Configuration_Specification => 216, - Iir_Kind_Access_Type_Definition => 223, - Iir_Kind_Incomplete_Type_Definition => 230, - Iir_Kind_File_Type_Definition => 237, - Iir_Kind_Protected_Type_Declaration => 246, - Iir_Kind_Record_Type_Definition => 256, - Iir_Kind_Array_Type_Definition => 268, - Iir_Kind_Array_Subtype_Definition => 283, - Iir_Kind_Record_Subtype_Definition => 294, - Iir_Kind_Access_Subtype_Definition => 302, - Iir_Kind_Physical_Subtype_Definition => 311, - Iir_Kind_Floating_Subtype_Definition => 321, - Iir_Kind_Integer_Subtype_Definition => 330, - Iir_Kind_Enumeration_Subtype_Definition => 339, - Iir_Kind_Enumeration_Type_Definition => 348, - Iir_Kind_Integer_Type_Definition => 354, - Iir_Kind_Floating_Type_Definition => 360, - Iir_Kind_Physical_Type_Definition => 369, - Iir_Kind_Range_Expression => 375, - Iir_Kind_Protected_Type_Body => 382, - Iir_Kind_Subtype_Definition => 386, - Iir_Kind_Scalar_Nature_Definition => 390, - Iir_Kind_Overload_List => 391, - Iir_Kind_Type_Declaration => 398, - Iir_Kind_Anonymous_Type_Declaration => 403, - Iir_Kind_Subtype_Declaration => 412, - Iir_Kind_Nature_Declaration => 419, - Iir_Kind_Subnature_Declaration => 426, - Iir_Kind_Package_Declaration => 436, - Iir_Kind_Package_Instantiation_Declaration => 447, - Iir_Kind_Package_Body => 453, - Iir_Kind_Configuration_Declaration => 462, - Iir_Kind_Entity_Declaration => 474, - Iir_Kind_Architecture_Body => 486, - Iir_Kind_Package_Header => 488, - Iir_Kind_Unit_Declaration => 498, - Iir_Kind_Library_Declaration => 504, - Iir_Kind_Component_Declaration => 515, - Iir_Kind_Attribute_Declaration => 522, - Iir_Kind_Group_Template_Declaration => 528, - Iir_Kind_Group_Declaration => 536, - Iir_Kind_Element_Declaration => 543, - Iir_Kind_Non_Object_Alias_Declaration => 551, - Iir_Kind_Psl_Declaration => 559, - Iir_Kind_Terminal_Declaration => 565, - Iir_Kind_Free_Quantity_Declaration => 575, - Iir_Kind_Across_Quantity_Declaration => 588, - Iir_Kind_Through_Quantity_Declaration => 601, - Iir_Kind_Enumeration_Literal => 614, - Iir_Kind_Function_Declaration => 638, - Iir_Kind_Implicit_Function_Declaration => 657, - Iir_Kind_Implicit_Procedure_Declaration => 674, - Iir_Kind_Procedure_Declaration => 696, - Iir_Kind_Function_Body => 704, - Iir_Kind_Procedure_Body => 712, - Iir_Kind_Object_Alias_Declaration => 724, - Iir_Kind_File_Declaration => 740, - Iir_Kind_Guard_Signal_Declaration => 753, - Iir_Kind_Signal_Declaration => 771, - Iir_Kind_Variable_Declaration => 785, - Iir_Kind_Constant_Declaration => 800, - Iir_Kind_Iterator_Declaration => 813, - Iir_Kind_Constant_Interface_Declaration => 828, - Iir_Kind_Variable_Interface_Declaration => 843, - Iir_Kind_Signal_Interface_Declaration => 862, - Iir_Kind_File_Interface_Declaration => 877, - Iir_Kind_Identity_Operator => 881, - Iir_Kind_Negation_Operator => 885, - Iir_Kind_Absolute_Operator => 889, - Iir_Kind_Not_Operator => 893, - Iir_Kind_Condition_Operator => 897, - Iir_Kind_Reduction_And_Operator => 901, - Iir_Kind_Reduction_Or_Operator => 905, - Iir_Kind_Reduction_Nand_Operator => 909, - Iir_Kind_Reduction_Nor_Operator => 913, - Iir_Kind_Reduction_Xor_Operator => 917, - Iir_Kind_Reduction_Xnor_Operator => 921, - Iir_Kind_And_Operator => 926, - Iir_Kind_Or_Operator => 931, - Iir_Kind_Nand_Operator => 936, - Iir_Kind_Nor_Operator => 941, - Iir_Kind_Xor_Operator => 946, - Iir_Kind_Xnor_Operator => 951, - Iir_Kind_Equality_Operator => 956, - Iir_Kind_Inequality_Operator => 961, - Iir_Kind_Less_Than_Operator => 966, - Iir_Kind_Less_Than_Or_Equal_Operator => 971, - Iir_Kind_Greater_Than_Operator => 976, - Iir_Kind_Greater_Than_Or_Equal_Operator => 981, - Iir_Kind_Match_Equality_Operator => 986, - Iir_Kind_Match_Inequality_Operator => 991, - Iir_Kind_Match_Less_Than_Operator => 996, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1001, - Iir_Kind_Match_Greater_Than_Operator => 1006, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1011, - Iir_Kind_Sll_Operator => 1016, - Iir_Kind_Sla_Operator => 1021, - Iir_Kind_Srl_Operator => 1026, - Iir_Kind_Sra_Operator => 1031, - Iir_Kind_Rol_Operator => 1036, - Iir_Kind_Ror_Operator => 1041, - Iir_Kind_Addition_Operator => 1046, - Iir_Kind_Substraction_Operator => 1051, - Iir_Kind_Concatenation_Operator => 1056, - Iir_Kind_Multiplication_Operator => 1061, - Iir_Kind_Division_Operator => 1066, - Iir_Kind_Modulus_Operator => 1071, - Iir_Kind_Remainder_Operator => 1076, - Iir_Kind_Exponentiation_Operator => 1081, - Iir_Kind_Function_Call => 1089, - Iir_Kind_Aggregate => 1095, - Iir_Kind_Parenthesis_Expression => 1098, - Iir_Kind_Qualified_Expression => 1102, - Iir_Kind_Type_Conversion => 1107, - Iir_Kind_Allocator_By_Expression => 1111, - Iir_Kind_Allocator_By_Subtype => 1115, - Iir_Kind_Selected_Element => 1121, - Iir_Kind_Dereference => 1126, - Iir_Kind_Implicit_Dereference => 1131, - Iir_Kind_Slice_Name => 1138, - Iir_Kind_Indexed_Name => 1144, - Iir_Kind_Psl_Expression => 1146, - Iir_Kind_Sensitized_Process_Statement => 1165, - Iir_Kind_Process_Statement => 1183, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1195, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1208, - Iir_Kind_Concurrent_Assertion_Statement => 1217, - Iir_Kind_Psl_Default_Clock => 1221, - Iir_Kind_Psl_Assert_Statement => 1231, - Iir_Kind_Psl_Cover_Statement => 1241, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1248, - Iir_Kind_Block_Statement => 1261, - Iir_Kind_Generate_Statement => 1273, - Iir_Kind_Component_Instantiation_Statement => 1284, - Iir_Kind_Simple_Simultaneous_Statement => 1292, - Iir_Kind_Signal_Assignment_Statement => 1302, - Iir_Kind_Null_Statement => 1307, - Iir_Kind_Assertion_Statement => 1315, - Iir_Kind_Report_Statement => 1322, - Iir_Kind_Wait_Statement => 1330, - Iir_Kind_Variable_Assignment_Statement => 1337, - Iir_Kind_Return_Statement => 1344, - Iir_Kind_For_Loop_Statement => 1353, - Iir_Kind_While_Loop_Statement => 1361, - Iir_Kind_Next_Statement => 1368, - Iir_Kind_Exit_Statement => 1375, - Iir_Kind_Case_Statement => 1383, - Iir_Kind_Procedure_Call_Statement => 1389, - Iir_Kind_If_Statement => 1398, - Iir_Kind_Elsif => 1403, - Iir_Kind_Character_Literal => 1410, - Iir_Kind_Simple_Name => 1417, - Iir_Kind_Selected_Name => 1425, - Iir_Kind_Operator_Symbol => 1430, - Iir_Kind_Selected_By_All_Name => 1435, - Iir_Kind_Parenthesis_Name => 1439, - Iir_Kind_Base_Attribute => 1441, - Iir_Kind_Left_Type_Attribute => 1446, - Iir_Kind_Right_Type_Attribute => 1451, - Iir_Kind_High_Type_Attribute => 1456, - Iir_Kind_Low_Type_Attribute => 1461, - Iir_Kind_Ascending_Type_Attribute => 1466, - Iir_Kind_Image_Attribute => 1472, - Iir_Kind_Value_Attribute => 1478, - Iir_Kind_Pos_Attribute => 1484, - Iir_Kind_Val_Attribute => 1490, - Iir_Kind_Succ_Attribute => 1496, - Iir_Kind_Pred_Attribute => 1502, - Iir_Kind_Leftof_Attribute => 1508, - Iir_Kind_Rightof_Attribute => 1514, - Iir_Kind_Delayed_Attribute => 1522, - Iir_Kind_Stable_Attribute => 1530, - Iir_Kind_Quiet_Attribute => 1538, - Iir_Kind_Transaction_Attribute => 1546, - Iir_Kind_Event_Attribute => 1550, - Iir_Kind_Active_Attribute => 1554, - Iir_Kind_Last_Event_Attribute => 1558, - Iir_Kind_Last_Active_Attribute => 1562, - Iir_Kind_Last_Value_Attribute => 1566, - Iir_Kind_Driving_Attribute => 1570, - Iir_Kind_Driving_Value_Attribute => 1574, - Iir_Kind_Behavior_Attribute => 1574, - Iir_Kind_Structure_Attribute => 1574, - Iir_Kind_Simple_Name_Attribute => 1581, - Iir_Kind_Instance_Name_Attribute => 1586, - Iir_Kind_Path_Name_Attribute => 1591, - Iir_Kind_Left_Array_Attribute => 1598, - Iir_Kind_Right_Array_Attribute => 1605, - Iir_Kind_High_Array_Attribute => 1612, - Iir_Kind_Low_Array_Attribute => 1619, - Iir_Kind_Length_Array_Attribute => 1626, - Iir_Kind_Ascending_Array_Attribute => 1633, - Iir_Kind_Range_Array_Attribute => 1640, - Iir_Kind_Reverse_Range_Array_Attribute => 1647, - Iir_Kind_Attribute_Name => 1655 + Iir_Kind_Association_Element_Package => 114, + Iir_Kind_Choice_By_Others => 119, + Iir_Kind_Choice_By_Expression => 126, + Iir_Kind_Choice_By_Range => 133, + Iir_Kind_Choice_By_None => 138, + Iir_Kind_Choice_By_Name => 144, + Iir_Kind_Entity_Aspect_Entity => 146, + Iir_Kind_Entity_Aspect_Configuration => 147, + Iir_Kind_Entity_Aspect_Open => 147, + Iir_Kind_Block_Configuration => 153, + Iir_Kind_Block_Header => 157, + Iir_Kind_Component_Configuration => 163, + Iir_Kind_Binding_Indication => 169, + Iir_Kind_Entity_Class => 171, + Iir_Kind_Attribute_Value => 179, + Iir_Kind_Signature => 182, + Iir_Kind_Aggregate_Info => 189, + Iir_Kind_Procedure_Call => 193, + Iir_Kind_Record_Element_Constraint => 199, + Iir_Kind_Array_Element_Resolution => 200, + Iir_Kind_Record_Resolution => 201, + Iir_Kind_Record_Element_Resolution => 204, + Iir_Kind_Attribute_Specification => 212, + Iir_Kind_Disconnection_Specification => 217, + Iir_Kind_Configuration_Specification => 222, + Iir_Kind_Access_Type_Definition => 229, + Iir_Kind_Incomplete_Type_Definition => 236, + Iir_Kind_File_Type_Definition => 243, + Iir_Kind_Protected_Type_Declaration => 252, + Iir_Kind_Record_Type_Definition => 262, + Iir_Kind_Array_Type_Definition => 274, + Iir_Kind_Array_Subtype_Definition => 289, + Iir_Kind_Record_Subtype_Definition => 300, + Iir_Kind_Access_Subtype_Definition => 308, + Iir_Kind_Physical_Subtype_Definition => 317, + Iir_Kind_Floating_Subtype_Definition => 327, + Iir_Kind_Integer_Subtype_Definition => 336, + Iir_Kind_Enumeration_Subtype_Definition => 345, + Iir_Kind_Enumeration_Type_Definition => 354, + Iir_Kind_Integer_Type_Definition => 360, + Iir_Kind_Floating_Type_Definition => 366, + Iir_Kind_Physical_Type_Definition => 375, + Iir_Kind_Range_Expression => 381, + Iir_Kind_Protected_Type_Body => 388, + Iir_Kind_Subtype_Definition => 392, + Iir_Kind_Scalar_Nature_Definition => 396, + Iir_Kind_Overload_List => 397, + Iir_Kind_Type_Declaration => 404, + Iir_Kind_Anonymous_Type_Declaration => 409, + Iir_Kind_Subtype_Declaration => 418, + Iir_Kind_Nature_Declaration => 425, + Iir_Kind_Subnature_Declaration => 432, + Iir_Kind_Package_Declaration => 442, + Iir_Kind_Package_Instantiation_Declaration => 453, + Iir_Kind_Package_Body => 459, + Iir_Kind_Configuration_Declaration => 468, + Iir_Kind_Entity_Declaration => 480, + Iir_Kind_Architecture_Body => 492, + Iir_Kind_Package_Header => 494, + Iir_Kind_Unit_Declaration => 504, + Iir_Kind_Library_Declaration => 510, + Iir_Kind_Component_Declaration => 521, + Iir_Kind_Attribute_Declaration => 528, + Iir_Kind_Group_Template_Declaration => 534, + Iir_Kind_Group_Declaration => 542, + Iir_Kind_Element_Declaration => 549, + Iir_Kind_Non_Object_Alias_Declaration => 557, + Iir_Kind_Psl_Declaration => 565, + Iir_Kind_Terminal_Declaration => 571, + Iir_Kind_Free_Quantity_Declaration => 581, + Iir_Kind_Across_Quantity_Declaration => 594, + Iir_Kind_Through_Quantity_Declaration => 607, + Iir_Kind_Enumeration_Literal => 620, + Iir_Kind_Function_Declaration => 643, + Iir_Kind_Implicit_Function_Declaration => 661, + Iir_Kind_Implicit_Procedure_Declaration => 677, + Iir_Kind_Procedure_Declaration => 698, + Iir_Kind_Function_Body => 707, + Iir_Kind_Procedure_Body => 716, + Iir_Kind_Object_Alias_Declaration => 728, + Iir_Kind_File_Declaration => 744, + Iir_Kind_Guard_Signal_Declaration => 757, + Iir_Kind_Signal_Declaration => 775, + Iir_Kind_Variable_Declaration => 789, + Iir_Kind_Constant_Declaration => 804, + Iir_Kind_Iterator_Declaration => 817, + Iir_Kind_Interface_Constant_Declaration => 832, + Iir_Kind_Interface_Variable_Declaration => 847, + Iir_Kind_Interface_Signal_Declaration => 866, + Iir_Kind_Interface_File_Declaration => 881, + Iir_Kind_Interface_Package_Declaration => 890, + Iir_Kind_Identity_Operator => 894, + Iir_Kind_Negation_Operator => 898, + Iir_Kind_Absolute_Operator => 902, + Iir_Kind_Not_Operator => 906, + Iir_Kind_Condition_Operator => 910, + Iir_Kind_Reduction_And_Operator => 914, + Iir_Kind_Reduction_Or_Operator => 918, + Iir_Kind_Reduction_Nand_Operator => 922, + Iir_Kind_Reduction_Nor_Operator => 926, + Iir_Kind_Reduction_Xor_Operator => 930, + Iir_Kind_Reduction_Xnor_Operator => 934, + Iir_Kind_And_Operator => 939, + Iir_Kind_Or_Operator => 944, + Iir_Kind_Nand_Operator => 949, + Iir_Kind_Nor_Operator => 954, + Iir_Kind_Xor_Operator => 959, + Iir_Kind_Xnor_Operator => 964, + Iir_Kind_Equality_Operator => 969, + Iir_Kind_Inequality_Operator => 974, + Iir_Kind_Less_Than_Operator => 979, + Iir_Kind_Less_Than_Or_Equal_Operator => 984, + Iir_Kind_Greater_Than_Operator => 989, + Iir_Kind_Greater_Than_Or_Equal_Operator => 994, + Iir_Kind_Match_Equality_Operator => 999, + Iir_Kind_Match_Inequality_Operator => 1004, + Iir_Kind_Match_Less_Than_Operator => 1009, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1014, + Iir_Kind_Match_Greater_Than_Operator => 1019, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1024, + Iir_Kind_Sll_Operator => 1029, + Iir_Kind_Sla_Operator => 1034, + Iir_Kind_Srl_Operator => 1039, + Iir_Kind_Sra_Operator => 1044, + Iir_Kind_Rol_Operator => 1049, + Iir_Kind_Ror_Operator => 1054, + Iir_Kind_Addition_Operator => 1059, + Iir_Kind_Substraction_Operator => 1064, + Iir_Kind_Concatenation_Operator => 1069, + Iir_Kind_Multiplication_Operator => 1074, + Iir_Kind_Division_Operator => 1079, + Iir_Kind_Modulus_Operator => 1084, + Iir_Kind_Remainder_Operator => 1089, + Iir_Kind_Exponentiation_Operator => 1094, + Iir_Kind_Function_Call => 1102, + Iir_Kind_Aggregate => 1108, + Iir_Kind_Parenthesis_Expression => 1111, + Iir_Kind_Qualified_Expression => 1115, + Iir_Kind_Type_Conversion => 1120, + Iir_Kind_Allocator_By_Expression => 1124, + Iir_Kind_Allocator_By_Subtype => 1128, + Iir_Kind_Selected_Element => 1134, + Iir_Kind_Dereference => 1139, + Iir_Kind_Implicit_Dereference => 1144, + Iir_Kind_Slice_Name => 1151, + Iir_Kind_Indexed_Name => 1157, + Iir_Kind_Psl_Expression => 1159, + Iir_Kind_Sensitized_Process_Statement => 1178, + Iir_Kind_Process_Statement => 1196, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1208, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1221, + Iir_Kind_Concurrent_Assertion_Statement => 1230, + Iir_Kind_Psl_Default_Clock => 1234, + Iir_Kind_Psl_Assert_Statement => 1244, + Iir_Kind_Psl_Cover_Statement => 1254, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1261, + Iir_Kind_Block_Statement => 1274, + Iir_Kind_Generate_Statement => 1286, + Iir_Kind_Component_Instantiation_Statement => 1297, + Iir_Kind_Simple_Simultaneous_Statement => 1305, + Iir_Kind_Signal_Assignment_Statement => 1315, + Iir_Kind_Null_Statement => 1320, + Iir_Kind_Assertion_Statement => 1328, + Iir_Kind_Report_Statement => 1335, + Iir_Kind_Wait_Statement => 1343, + Iir_Kind_Variable_Assignment_Statement => 1350, + Iir_Kind_Return_Statement => 1357, + Iir_Kind_For_Loop_Statement => 1366, + Iir_Kind_While_Loop_Statement => 1374, + Iir_Kind_Next_Statement => 1381, + Iir_Kind_Exit_Statement => 1388, + Iir_Kind_Case_Statement => 1396, + Iir_Kind_Procedure_Call_Statement => 1402, + Iir_Kind_If_Statement => 1411, + Iir_Kind_Elsif => 1416, + Iir_Kind_Character_Literal => 1423, + Iir_Kind_Simple_Name => 1430, + Iir_Kind_Selected_Name => 1438, + Iir_Kind_Operator_Symbol => 1443, + Iir_Kind_Selected_By_All_Name => 1448, + Iir_Kind_Parenthesis_Name => 1452, + Iir_Kind_Base_Attribute => 1454, + Iir_Kind_Left_Type_Attribute => 1459, + Iir_Kind_Right_Type_Attribute => 1464, + Iir_Kind_High_Type_Attribute => 1469, + Iir_Kind_Low_Type_Attribute => 1474, + Iir_Kind_Ascending_Type_Attribute => 1479, + Iir_Kind_Image_Attribute => 1485, + Iir_Kind_Value_Attribute => 1491, + Iir_Kind_Pos_Attribute => 1497, + Iir_Kind_Val_Attribute => 1503, + Iir_Kind_Succ_Attribute => 1509, + Iir_Kind_Pred_Attribute => 1515, + Iir_Kind_Leftof_Attribute => 1521, + Iir_Kind_Rightof_Attribute => 1527, + Iir_Kind_Delayed_Attribute => 1535, + Iir_Kind_Stable_Attribute => 1543, + Iir_Kind_Quiet_Attribute => 1551, + Iir_Kind_Transaction_Attribute => 1559, + Iir_Kind_Event_Attribute => 1563, + Iir_Kind_Active_Attribute => 1567, + Iir_Kind_Last_Event_Attribute => 1571, + Iir_Kind_Last_Active_Attribute => 1575, + Iir_Kind_Last_Value_Attribute => 1579, + Iir_Kind_Driving_Attribute => 1583, + Iir_Kind_Driving_Value_Attribute => 1587, + Iir_Kind_Behavior_Attribute => 1587, + Iir_Kind_Structure_Attribute => 1587, + Iir_Kind_Simple_Name_Attribute => 1594, + Iir_Kind_Instance_Name_Attribute => 1599, + Iir_Kind_Path_Name_Attribute => 1604, + Iir_Kind_Left_Array_Attribute => 1611, + Iir_Kind_Right_Array_Attribute => 1618, + Iir_Kind_High_Array_Attribute => 1625, + Iir_Kind_Low_Array_Attribute => 1632, + Iir_Kind_Length_Array_Attribute => 1639, + Iir_Kind_Ascending_Array_Attribute => 1646, + Iir_Kind_Range_Array_Attribute => 1653, + Iir_Kind_Reverse_Range_Array_Attribute => 1660, + Iir_Kind_Attribute_Name => 1668 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4606,8 +4632,8 @@ package body Nodes_Meta is return Get_Package_Header (N); when Field_Block_Header => return Get_Block_Header (N); - when Field_Uninstantiated_Name => - return Get_Uninstantiated_Name (N); + when Field_Uninstantiated_Package_Name => + return Get_Uninstantiated_Package_Name (N); when Field_Generate_Block_Configuration => return Get_Generate_Block_Configuration (N); when Field_Generation_Scheme => @@ -4666,6 +4692,8 @@ package body Nodes_Meta is return Get_Parameter (N); when Field_Actual_Type => return Get_Actual_Type (N); + when Field_Associated_Interface => + return Get_Associated_Interface (N); when Field_Association_Chain => return Get_Association_Chain (N); when Field_Individual_Association_Chain => @@ -4966,8 +4994,8 @@ package body Nodes_Meta is Set_Package_Header (N, V); when Field_Block_Header => Set_Block_Header (N, V); - when Field_Uninstantiated_Name => - Set_Uninstantiated_Name (N, V); + when Field_Uninstantiated_Package_Name => + Set_Uninstantiated_Package_Name (N, V); when Field_Generate_Block_Configuration => Set_Generate_Block_Configuration (N, V); when Field_Generation_Scheme => @@ -5026,6 +5054,8 @@ package body Nodes_Meta is Set_Parameter (N, V); when Field_Actual_Type => Set_Actual_Type (N, V); + when Field_Associated_Interface => + Set_Associated_Interface (N, V); when Field_Association_Chain => Set_Association_Chain (N, V); when Field_Individual_Association_Chain => @@ -6112,7 +6142,8 @@ package body Nodes_Meta is case K is when Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => + | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package => return True; when others => return False; @@ -6121,7 +6152,13 @@ package body Nodes_Meta is function Has_Actual (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Association_Element_By_Expression; + case K is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_Package => + return True; + when others => + return False; + end case; end Has_Actual; function Has_In_Conversion (K : Iir_Kind) return Boolean is @@ -6139,7 +6176,8 @@ package body Nodes_Meta is case K is when Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => + | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package => return True; when others => return False; @@ -6151,7 +6189,8 @@ package body Nodes_Meta is case K is when Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => + | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package => return True; when others => return False; @@ -6165,7 +6204,7 @@ package body Nodes_Meta is function Has_Open_Flag (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Signal_Interface_Declaration; + return K = Iir_Kind_Interface_Signal_Declaration; end Has_Open_Flag; function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean is @@ -6173,10 +6212,10 @@ package body Nodes_Meta is case K is when Iir_Kind_Object_Alias_Declaration | Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => return True; when others => return False; @@ -6299,10 +6338,11 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -6414,6 +6454,7 @@ package body Nodes_Meta is | Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package | Iir_Kind_Choice_By_Others | Iir_Kind_Choice_By_Expression | Iir_Kind_Choice_By_Range @@ -6457,10 +6498,11 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -6521,7 +6563,8 @@ package body Nodes_Meta is | Iir_Kind_Function_Declaration | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Package_Declaration => return True; when others => return False; @@ -6562,10 +6605,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator @@ -6683,10 +6726,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Allocator_By_Subtype => return True; when others => @@ -6731,10 +6774,10 @@ package body Nodes_Meta is begin case K is when Iir_Kind_File_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => return True; when others => return False; @@ -6746,7 +6789,7 @@ package body Nodes_Meta is case K is when Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => return True; when others => return False; @@ -6947,10 +6990,10 @@ package body Nodes_Meta is | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => return True; when others => return False; @@ -7011,6 +7054,7 @@ package body Nodes_Meta is | Iir_Kind_Architecture_Body | Iir_Kind_Function_Body | Iir_Kind_Procedure_Body + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement @@ -7158,10 +7202,11 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -7274,10 +7319,11 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -7700,10 +7746,8 @@ package body Nodes_Meta is function Has_Callees_List (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement => return True; @@ -7951,6 +7995,7 @@ package body Nodes_Meta is | Iir_Kind_Package_Header | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Component_Instantiation_Statement => return True; when others => @@ -8066,10 +8111,16 @@ package body Nodes_Meta is return K = Iir_Kind_Block_Statement; end Has_Block_Header; - function Has_Uninstantiated_Name (K : Iir_Kind) return Boolean is + function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Package_Instantiation_Declaration; - end Has_Uninstantiated_Name; + case K is + when Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Package_Declaration => + return True; + when others => + return False; + end case; + end Has_Uninstantiated_Package_Name; function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is begin @@ -8167,10 +8218,11 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment @@ -8327,10 +8379,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator @@ -8582,10 +8634,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Function_Call | Iir_Kind_Selected_Element | Iir_Kind_Dereference @@ -8759,6 +8811,11 @@ package body Nodes_Meta is return K = Iir_Kind_Association_Element_By_Individual; end Has_Actual_Type; + function Has_Associated_Interface (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_Package; + end Has_Associated_Interface; + function Has_Association_Chain (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Parenthesis_Name; @@ -8978,10 +9035,10 @@ package body Nodes_Meta is function Has_Lexical_Layout (K : Iir_Kind) return Boolean is begin case K is - 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 => return True; when others => return False; @@ -8997,7 +9054,7 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => return True; when others => return False; @@ -9009,7 +9066,7 @@ package body Nodes_Meta is case K is when Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -9140,10 +9197,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => return True; when others => return False; @@ -9289,10 +9346,10 @@ package body Nodes_Meta is | Iir_Kind_Variable_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => return True; when others => return False; diff --git a/nodes_meta.ads b/nodes_meta.ads index 4183fc8..2d1f5e1 100644 --- a/nodes_meta.ads +++ b/nodes_meta.ads @@ -254,7 +254,7 @@ package Nodes_Meta is Field_Block_Block_Configuration, Field_Package_Header, Field_Block_Header, - Field_Uninstantiated_Name, + Field_Uninstantiated_Package_Name, Field_Generate_Block_Configuration, Field_Generation_Scheme, Field_Condition, @@ -287,6 +287,7 @@ package Nodes_Meta is Field_Index_Subtype, Field_Parameter, Field_Actual_Type, + Field_Associated_Interface, Field_Association_Chain, Field_Individual_Association_Chain, Field_Aggregate_Info, @@ -725,7 +726,7 @@ package Nodes_Meta is function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean; function Has_Package_Header (K : Iir_Kind) return Boolean; function Has_Block_Header (K : Iir_Kind) return Boolean; - function Has_Uninstantiated_Name (K : Iir_Kind) return Boolean; + function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean; function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean; function Has_Generation_Scheme (K : Iir_Kind) return Boolean; function Has_Condition (K : Iir_Kind) return Boolean; @@ -760,6 +761,7 @@ package Nodes_Meta is function Has_Index_Subtype (K : Iir_Kind) return Boolean; function Has_Parameter (K : Iir_Kind) return Boolean; function Has_Actual_Type (K : Iir_Kind) return Boolean; + function Has_Associated_Interface (K : Iir_Kind) return Boolean; function Has_Association_Chain (K : Iir_Kind) return Boolean; function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean; function Has_Aggregate_Info (K : Iir_Kind) return Boolean; @@ -56,7 +56,8 @@ package body Parse is function Parse_Primary return Iir_Expression; function Parse_Use_Clause return Iir_Use_Clause; - function Parse_Association_Chain return Iir; + function Parse_Association_List return Iir; + function Parse_Association_List_In_Parenthesis return Iir; function Parse_Sequential_Statements (Parent : Iir) return Iir; function Parse_Configuration_Item return Iir; @@ -838,7 +839,8 @@ package body Parse is Res := Create_Iir (Iir_Kind_Parenthesis_Name); Set_Location (Res); Set_Prefix (Res, Prefix); - Set_Association_Chain (Res, Parse_Association_Chain); + Set_Association_Chain + (Res, Parse_Association_List_In_Parenthesis); when Tok_Dot => if Get_Kind (Prefix) = Iir_Kind_String_Literal then @@ -930,16 +932,10 @@ package body Parse is return Res; end Parse_Type_Mark; - -- precond : '(' - -- postcond: next token - -- - -- [ LRM93 4.3.2.1 ] - -- interface_list ::= interface_element { ; interface_element } - -- - -- [ LRM93 4.3.2.1 ] - -- interface_element ::= interface_declaration + -- precond : CONSTANT, SIGNAL, VARIABLE. FILE or identifier + -- postcond: next token (';' or ')') -- - -- [ LRM93 4.3.2 ] + -- [ LRM93 4.3.2 ] [ LRM08 6.5.2 ] -- interface_declaration ::= interface_constant_declaration -- | interface_signal_declaration -- | interface_variable_declaration @@ -968,9 +964,10 @@ package body Parse is -- [ := STATIC_expression ] -- -- The default kind of interface declaration is DEFAULT. - function Parse_Interface_Chain (Default: Iir_Kind; Parent : Iir) - return Iir + function Parse_Interface_Object_Declaration (Ctxt : Interface_Kind_Type) + return Iir is + Kind : Iir_Kind; Res, Last : Iir; First, Prev_First : Iir; Inter: Iir; @@ -980,6 +977,305 @@ package body Parse is Signal_Kind: Iir_Signal_Kind; Default_Value: Iir; Lexical_Layout : Iir_Lexical_Layout_Type; + begin + Res := Null_Iir; + Last := Null_Iir; + + -- LRM08 6.5.2 Interface object declarations + -- Interface obejcts include interface constants that appear as + -- generics of a design entity, a component, a block, a package or + -- a subprogram, or as constant parameter of subprograms; interface + -- signals that appear as ports of a design entity, component or + -- block, or as signal parameters of subprograms; interface variables + -- that appear as variable parameter subprograms; interface files + -- that appear as file parameters of subrograms. + case Current_Token is + when Tok_Identifier => + -- The class of the object is unknown. Select default + -- according to the above rule, assuming the mode is IN. If + -- the mode is not IN, Parse_Interface_Object_Declaration will + -- change the class. + case Ctxt is + when Generic_Interface_List + | Parameter_Interface_List => + Kind := Iir_Kind_Interface_Constant_Declaration; + when Port_Interface_List => + Kind := Iir_Kind_Interface_Signal_Declaration; + end case; + when Tok_Constant => + Kind := Iir_Kind_Interface_Constant_Declaration; + when Tok_Signal => + if Ctxt = Generic_Interface_List then + Error_Msg_Parse + ("signal interface not allowed in generic clause"); + end if; + Kind := Iir_Kind_Interface_Signal_Declaration; + when Tok_Variable => + if Ctxt not in Parameter_Interface_List then + Error_Msg_Parse + ("variable interface not allowed in generic or port clause"); + end if; + Kind := Iir_Kind_Interface_Variable_Declaration; + when Tok_File => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("file interface not allowed in vhdl 87"); + end if; + if Ctxt not in Parameter_Interface_List then + Error_Msg_Parse + ("variable interface not allowed in generic or port clause"); + end if; + Kind := Iir_Kind_Interface_File_Declaration; + when others => + -- Fall back in case of parse error. + Kind := Iir_Kind_Interface_Variable_Declaration; + end case; + + Inter := Create_Iir (Kind); + + if Current_Token = Tok_Identifier then + Is_Default := True; + Lexical_Layout := 0; + else + Is_Default := False; + Lexical_Layout := Iir_Lexical_Has_Class; + + -- Skip 'signal', 'variable', 'constant' or 'file'. + Scan; + end if; + + Prev_First := Last; + First := Inter; + loop + if Current_Token /= Tok_Identifier then + Expect (Tok_Identifier); + end if; + Set_Identifier (Inter, Current_Identifier); + Set_Location (Inter); + + if Res = Null_Iir then + Res := Inter; + else + Set_Chain (Last, Inter); + end if; + Last := Inter; + + -- Skip identifier + Scan; + + exit when Current_Token = Tok_Colon; + Expect (Tok_Comma, "',' or ':' expected after identifier"); + + -- Skip ',' + Scan; + + Inter := Create_Iir (Kind); + end loop; + + Expect (Tok_Colon, "':' must follow the interface element identifier"); + + -- Skip ':' + Scan; + + -- LRM93 2.1.1 LRM08 4.2.2.1 + -- If the mode is INOUT or OUT, and no object class is explicitly + -- specified, variable is assumed. + if Is_Default + and then Ctxt in Parameter_Interface_List + and then (Current_Token = Tok_Inout or else Current_Token = Tok_Out) + then + -- Convert into variable. + declare + O_Interface : Iir_Interface_Constant_Declaration; + N_Interface : Iir_Interface_Variable_Declaration; + begin + O_Interface := First; + while O_Interface /= Null_Iir loop + N_Interface := + Create_Iir (Iir_Kind_Interface_Variable_Declaration); + Location_Copy (N_Interface, O_Interface); + Set_Identifier (N_Interface, + Get_Identifier (O_Interface)); + if Prev_First = Null_Iir then + Res := N_Interface; + else + Set_Chain (Prev_First, N_Interface); + end if; + Prev_First := N_Interface; + if O_Interface = First then + First := N_Interface; + end if; + Last := N_Interface; + Inter := Get_Chain (O_Interface); + Free_Iir (O_Interface); + O_Interface := Inter; + end loop; + Inter := First; + end; + end if; + + -- Update lexical layout if mode is present. + case Current_Token is + when Tok_In + | Tok_Out + | Tok_Inout + | Tok_Linkage + | Tok_Buffer => + Lexical_Layout := Lexical_Layout or Iir_Lexical_Has_Mode; + when others => + null; + end case; + + -- Parse mode (and handle default mode). + case Get_Kind (Inter) is + when Iir_Kind_Interface_File_Declaration => + if Parse_Mode (Iir_Unknown_Mode) /= Iir_Unknown_Mode then + Error_Msg_Parse + ("mode can't be specified for a file interface"); + end if; + Interface_Mode := Iir_Inout_Mode; + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration => + -- LRM93 4.3.2 + -- If no mode is explicitly given in an interface declaration + -- other than an interface file declaration, mode IN is + -- assumed. + Interface_Mode := Parse_Mode (Iir_In_Mode); + when Iir_Kind_Interface_Constant_Declaration => + Interface_Mode := Parse_Mode (Iir_In_Mode); + if Interface_Mode /= Iir_In_Mode then + Error_Msg_Parse ("mode must be 'in' for a constant"); + end if; + when others => + raise Internal_Error; + end case; + + Interface_Type := Parse_Subtype_Indication; + + -- Signal kind (but only for signal). + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then + Signal_Kind := Parse_Signal_Kind; + else + Signal_Kind := Iir_No_Signal_Kind; + end if; + + if Current_Token = Tok_Assign then + if Get_Kind (Inter) = Iir_Kind_Interface_File_Declaration then + Error_Msg_Parse + ("default expression not allowed for an interface file"); + end if; + + -- Skip ':=' + Scan; + + Default_Value := Parse_Expression; + else + Default_Value := Null_Iir; + end if; + + -- Subtype_Indication and Default_Value are set only on the first + -- interface. + Set_Subtype_Indication (First, Interface_Type); + if Get_Kind (First) /= Iir_Kind_Interface_File_Declaration then + Set_Default_Value (First, Default_Value); + end if; + + Inter := First; + while Inter /= Null_Iir loop + Set_Mode (Inter, Interface_Mode); + Set_Is_Ref (Inter, Inter /= First); + if Inter = Last then + Set_Lexical_Layout (Inter, + Lexical_Layout or Iir_Lexical_Has_Type); + else + Set_Lexical_Layout (Inter, Lexical_Layout); + end if; + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then + Set_Signal_Kind (Inter, Signal_Kind); + end if; + Inter := Get_Chain (Inter); + end loop; + + return Res; + end Parse_Interface_Object_Declaration; + + -- Precond : 'package' + -- Postcond: next token + -- + -- LRM08 6.5.5 Interface package declarations + -- interface_package_declaration ::= + -- PACKAGE identifier IS NEW uninstantiated_package name + -- interface_package_generic_map_aspect + -- + -- interface_package_generic_map_aspect ::= + -- generic_map_aspect + -- | GENERIC MAP ( <> ) + -- | GENERIC MAP ( DEFAULT ) + function Parse_Interface_Package_Declaration return Iir + is + Inter : Iir; + Map : Iir; + begin + Inter := Create_Iir (Iir_Kind_Interface_Package_Declaration); + + -- Skip 'package' + Scan_Expect (Tok_Identifier, + "an identifier is expected after ""package"""); + Set_Identifier (Inter, Current_Identifier); + Set_Location (Inter); + + -- Skip identifier + Scan_Expect (Tok_Is); + + -- Skip 'is' + Scan_Expect (Tok_New); + + -- Skip 'new' + Scan; + + Set_Uninstantiated_Package_Name (Inter, Parse_Name (False)); + + Expect (Tok_Generic); + + -- Skip 'generic' + Scan_Expect (Tok_Map); + + -- Skip 'map' + Scan_Expect (Tok_Left_Paren); + + -- Skip '(' + Scan; + + case Current_Token is + when Tok_Box => + Map := Null_Iir; + -- Skip '<>' + Scan; + when others => + Map := Parse_Association_List; + end case; + Set_Generic_Map_Aspect_Chain (Inter, Map); + + Expect (Tok_Right_Paren); + + -- Skip ')' + Scan; + + return Inter; + end Parse_Interface_Package_Declaration; + + -- Precond : '(' + -- Postcond: next token + -- + -- LRM08 6.5.6 Interface lists + -- interface_list ::= interface_element { ';' interface_element } + -- + -- interface_element ::= interface_declaration + function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir) + return Iir + is + Res, Last : Iir; + Inters : Iir; + Next : Iir; Prev_Loc : Location_Type; begin Expect (Tok_Left_Paren); @@ -993,19 +1289,22 @@ package body Parse is Scan; case Current_Token is - when Tok_Identifier => - Inter := Create_Iir (Default); - when Tok_Signal => - Inter := Create_Iir (Iir_Kind_Signal_Interface_Declaration); - when Tok_Variable => - Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration); - when Tok_Constant => - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); - when Tok_File => - if Flags.Vhdl_Std = Vhdl_87 then - Error_Msg_Parse ("file interface not allowed in vhdl 87"); + when Tok_Identifier + | Tok_Signal + | Tok_Variable + | Tok_Constant + | Tok_File => + -- An inteface object. + Inters := Parse_Interface_Object_Declaration (Ctxt); + when Tok_Package => + if Ctxt /= Generic_Interface_List then + Error_Msg_Parse + ("package interface only allowed in generic interface"); + elsif Flags.Vhdl_Std < Vhdl_08 then + Error_Msg_Parse + ("package interface not allowed before vhdl 08"); end if; - Inter := Create_Iir (Iir_Kind_File_Interface_Declaration); + Inters := Parse_Interface_Package_Declaration; when Tok_Right_Paren => if Res = Null_Iir then Error_Msg_Parse @@ -1020,172 +1319,25 @@ package body Parse is ("'signal', 'constant', 'variable', 'file' " & "or identifier expected"); -- Use a variable interface as a fall-back. - Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Inters := Parse_Interface_Object_Declaration (Ctxt); end case; - if Current_Token = Tok_Identifier then - Is_Default := True; - Lexical_Layout := 0; - else - Is_Default := False; - Lexical_Layout := Iir_Lexical_Has_Class; - -- Skip 'signal', 'variable', 'constant' or 'file'. - Scan; + -- Chain + if Last = Null_Iir then + Res := Inters; + else + Set_Chain (Last, Inters); end if; - Prev_First := Last; - First := Inter; + -- Set parent and set Last to the last interface. + Last := Inters; loop - if Current_Token /= Tok_Identifier then - Expect (Tok_Identifier); - end if; - Set_Identifier (Inter, Current_Identifier); - Set_Location (Inter); - - if Res = Null_Iir then - Res := Inter; - else - Set_Chain (Last, Inter); - end if; - Last := Inter; - - -- Skip identifier - Scan; - - exit when Current_Token = Tok_Colon; - Expect (Tok_Comma, "',' or ':' expected after identifier"); - - -- Skip ',' - Scan; - - Inter := Create_Iir (Get_Kind (Inter)); + Set_Parent (Last, Parent); + Next := Get_Chain (Last); + exit when Next = Null_Iir; + Last := Next; end loop; - Expect (Tok_Colon, - "':' must follow the interface element identifier"); - - -- Skip ':' - Scan; - - -- LRM93 2.1.1 - -- If the mode is INOUT or OUT, and no object class is explicitly - -- specified, variable is assumed. - if Is_Default - and then Default /= Iir_Kind_Signal_Interface_Declaration - and then (Current_Token = Tok_Inout or else Current_Token = Tok_Out) - then - -- Convert into variable. - declare - O_Interface : Iir_Constant_Interface_Declaration; - N_Interface : Iir_Variable_Interface_Declaration; - begin - O_Interface := First; - while O_Interface /= Null_Iir loop - N_Interface := - Create_Iir (Iir_Kind_Variable_Interface_Declaration); - Location_Copy (N_Interface, O_Interface); - Set_Identifier (N_Interface, - Get_Identifier (O_Interface)); - if Prev_First = Null_Iir then - Res := N_Interface; - else - Set_Chain (Prev_First, N_Interface); - end if; - Prev_First := N_Interface; - if O_Interface = First then - First := N_Interface; - end if; - Last := N_Interface; - Inter := Get_Chain (O_Interface); - Free_Iir (O_Interface); - O_Interface := Inter; - end loop; - Inter := First; - end; - end if; - - -- Update lexical layout if mode is present. - case Current_Token is - when Tok_In - | Tok_Out - | Tok_Inout - | Tok_Linkage - | Tok_Buffer => - Lexical_Layout := Lexical_Layout or Iir_Lexical_Has_Mode; - when others => - null; - end case; - - -- Parse mode (and handle default mode). - case Get_Kind (Inter) is - when Iir_Kind_File_Interface_Declaration => - if Parse_Mode (Iir_Unknown_Mode) /= Iir_Unknown_Mode then - Error_Msg_Parse - ("mode can't be specified for a file interface"); - end if; - Interface_Mode := Iir_Inout_Mode; - when Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration => - -- LRM93 4.3.2 - -- If no mode is explicitly given in an interface declaration - -- other than an interface file declaration, mode IN is - -- assumed. - Interface_Mode := Parse_Mode (Iir_In_Mode); - when Iir_Kind_Constant_Interface_Declaration => - Interface_Mode := Parse_Mode (Iir_In_Mode); - if Interface_Mode /= Iir_In_Mode then - Error_Msg_Parse ("mode must be 'in' for a constant"); - end if; - when others => - raise Internal_Error; - end case; - - Interface_Type := Parse_Subtype_Indication; - - -- Signal kind (but only for signal). - if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then - Signal_Kind := Parse_Signal_Kind; - else - Signal_Kind := Iir_No_Signal_Kind; - end if; - - if Current_Token = Tok_Assign then - if Get_Kind (Inter) = Iir_Kind_File_Interface_Declaration then - Error_Msg_Parse - ("default expression not allowed for an interface file"); - end if; - - -- Skip ':=' - Scan; - - Default_Value := Parse_Expression; - else - Default_Value := Null_Iir; - end if; - - -- Subtype_Indication and Default_Value are set only on the first - -- interface. - Set_Subtype_Indication (First, Interface_Type); - if Get_Kind (First) /= Iir_Kind_File_Interface_Declaration then - Set_Default_Value (First, Default_Value); - end if; - - Inter := First; - while Inter /= Null_Iir loop - Set_Mode (Inter, Interface_Mode); - Set_Parent (Inter, Parent); - Set_Is_Ref (Inter, Inter /= First); - if Inter = Last then - Set_Lexical_Layout (Inter, - Lexical_Layout or Iir_Lexical_Has_Type); - else - Set_Lexical_Layout (Inter, Lexical_Layout); - end if; - if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then - Set_Signal_Kind (Inter, Signal_Kind); - end if; - Inter := Get_Chain (Inter); - end loop; exit when Current_Token /= Tok_Semi_Colon; end loop; @@ -1197,7 +1349,7 @@ package body Parse is Scan; return Res; - end Parse_Interface_Chain; + end Parse_Interface_List; -- precond : PORT -- postcond: next token @@ -1216,13 +1368,12 @@ package body Parse is pragma Assert (Current_Token = Tok_Port); Scan; - Res := Parse_Interface_Chain - (Iir_Kind_Signal_Interface_Declaration, Parent); + Res := Parse_Interface_List (Port_Interface_List, Parent); -- Check the interface are signal interfaces. El := Res; while El /= Null_Iir loop - if Get_Kind (El) /= Iir_Kind_Signal_Interface_Declaration then + if Get_Kind (El) /= Iir_Kind_Interface_Signal_Declaration then Error_Msg_Parse ("port must be a signal", El); end if; El := Get_Chain (El); @@ -1248,8 +1399,7 @@ package body Parse is pragma Assert (Current_Token = Tok_Generic); Scan; - Res := Parse_Interface_Chain - (Iir_Kind_Constant_Interface_Declaration, Parent); + Res := Parse_Interface_List (Generic_Interface_List, Parent); Set_Generic_Chain (Parent, Res); Scan_Semi_Colon ("generic clause"); @@ -5136,6 +5286,8 @@ package body Parse is -- operator_symbol ::= string_literal function Parse_Subprogram_Declaration (Parent : Iir) return Iir is + Kind : Iir_Kind; + Inters : Iir; Subprg: Iir; Subprg_Body : Iir; Old : Iir; @@ -5144,14 +5296,15 @@ package body Parse is -- Create the node. case Current_Token is when Tok_Procedure => - Subprg := Create_Iir (Iir_Kind_Procedure_Declaration); + Kind := Iir_Kind_Procedure_Declaration; when Tok_Function | Tok_Pure | Tok_Impure => - Subprg := Create_Iir (Iir_Kind_Function_Declaration); + Kind := Iir_Kind_Function_Declaration; when others => raise Internal_Error; end case; + Subprg := Create_Iir (Kind); Set_Location (Subprg); case Current_Token is @@ -5185,7 +5338,7 @@ package body Parse is Set_Identifier (Subprg, Current_Identifier); Set_Location (Subprg); elsif Current_Token = Tok_String then - if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + if Kind = Iir_Kind_Procedure_Declaration then -- LRM93 2.1 -- A procedure designator is always an identifier. Error_Msg_Parse ("a procedure name must be an identifier"); @@ -5203,14 +5356,18 @@ package body Parse is Scan; if Current_Token = Tok_Left_Paren then -- Parse the interface declaration. - Set_Interface_Declaration_Chain - (Subprg, - Parse_Interface_Chain (Iir_Kind_Constant_Interface_Declaration, - Subprg)); + if Kind = Iir_Kind_Function_Declaration then + Inters := Parse_Interface_List + (Function_Parameter_Interface_List, Subprg); + else + Inters := Parse_Interface_List + (Procedure_Parameter_Interface_List, Subprg); + end if; + Set_Interface_Declaration_Chain (Subprg, Inters); end if; if Current_Token = Tok_Return then - if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + if Kind = Iir_Kind_Procedure_Declaration then Error_Msg_Parse ("'return' not allowed for a procedure"); Error_Msg_Parse ("(remove return part or define a function)"); @@ -5226,7 +5383,7 @@ package body Parse is (Subprg, Parse_Type_Mark (Check_Paren => True)); end if; else - if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + if Kind = Iir_Kind_Function_Declaration then Error_Msg_Parse ("'return' expected"); end if; end if; @@ -5237,7 +5394,7 @@ package body Parse is -- The body. Set_Has_Body (Subprg, True); - if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + if Kind = Iir_Kind_Function_Declaration then Subprg_Body := Create_Iir (Iir_Kind_Function_Body); else Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body); @@ -5266,7 +5423,7 @@ package body Parse is if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("'function' not allowed here by vhdl 87"); end if; - if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + if Kind = Iir_Kind_Procedure_Declaration then Error_Msg_Parse ("'procedure' expected instead of 'function'"); end if; Set_End_Has_Reserved_Id (Subprg_Body, True); @@ -5275,7 +5432,7 @@ package body Parse is if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("'procedure' not allowed here by vhdl 87"); end if; - if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + if Kind = Iir_Kind_Function_Declaration then Error_Msg_Parse ("'function' expected instead of 'procedure'"); end if; Set_End_Has_Reserved_Id (Subprg_Body, True); @@ -5397,39 +5554,39 @@ package body Parse is return Res; end Parse_Process_Statement; - -- precond : '(' + -- precond : NEXT_TOKEN -- postcond: NEXT_TOKEN -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- association_list ::= association_element { , association_element } -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- association_element ::= [ formal_part => ] actual_part -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- actual_part ::= actual_designator -- | FUNCTION_name ( actual_designator ) -- | type_mark ( actual_designator ) -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- actual_designator ::= expression -- | SIGNAL_name -- | VARIABLE_name -- | FILE_name -- | OPEN -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- formal_part ::= formal_designator -- | FUNCTION_name ( formal_designator ) -- | type_mark ( formal_designator ) -- - -- [ §4.3.2.2 ] + -- [ LRM93 4.3.2.2 ] -- formal_designator ::= GENERIC_name -- | PORT_name -- | PARAMETER_name -- -- Note: an actual part is parsed as an expression. - function Parse_Association_Chain return Iir + function Parse_Association_List return Iir is Res, Last: Iir; El: Iir; @@ -5440,10 +5597,6 @@ package body Parse is begin Sub_Chain_Init (Res, Last); - -- Skip '(' - Expect (Tok_Left_Paren); - Scan; - if Current_Token = Tok_Right_Paren then Error_Msg_Parse ("empty association list is not allowed"); return Res; @@ -5510,11 +5663,28 @@ package body Parse is Nbr_Assocs := Nbr_Assocs + 1; end loop; + return Res; + end Parse_Association_List; + + -- precond : NEXT_TOKEN + -- postcond: NEXT_TOKEN + -- + -- Parse: '(' association_list ')' + function Parse_Association_List_In_Parenthesis return Iir + is + Res : Iir; + begin + -- Skip '(' + Expect (Tok_Left_Paren); + Scan; + + Res := Parse_Association_List; + -- Skip ')' Scan; return Res; - end Parse_Association_Chain; + end Parse_Association_List_In_Parenthesis; -- precond : GENERIC -- postcond: next token @@ -5526,7 +5696,7 @@ package body Parse is Expect (Tok_Generic); Scan_Expect (Tok_Map); Scan; - return Parse_Association_Chain; + return Parse_Association_List_In_Parenthesis; end Parse_Generic_Map_Aspect; -- precond : PORT @@ -5539,7 +5709,7 @@ package body Parse is Expect (Tok_Port); Scan_Expect (Tok_Map); Scan; - return Parse_Association_Chain; + return Parse_Association_List_In_Parenthesis; end Parse_Port_Map_Aspect; -- precond : COMPONENT | ENTIY | CONFIGURATION @@ -6800,7 +6970,7 @@ package body Parse is -- Skip 'new' Scan; - Set_Uninstantiated_Name (Res, Parse_Name (False)); + Set_Uninstantiated_Package_Name (Res, Parse_Name (False)); if Current_Token = Tok_Generic then Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); @@ -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 @@ -74,4 +74,9 @@ package Sem is procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit; Emit_Warnings : Boolean); + -- Analyze the uninstantiated package name of DECL, and return the + -- package declaration. Return Null_Iir if the name doesn't denote an + -- uninstantiated package. + function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir; + end Sem; diff --git a/sem_assocs.adb b/sem_assocs.adb index ee43e30..96e6608 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -26,6 +26,97 @@ with Iir_Chains; use Iir_Chains; with Xrefs; package body Sem_Assocs is + function Rewrite_Non_Object_Association (Assoc : Iir; Inter : Iir) + return Iir + is + N_Assoc : Iir; + begin + case Get_Kind (Inter) is + when Iir_Kind_Interface_Package_Declaration => + N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package); + when others => + Error_Kind ("rewrite_non_object_association", Inter); + end case; + Location_Copy (N_Assoc, Assoc); + Set_Formal (N_Assoc, Get_Formal (Assoc)); + Set_Actual (N_Assoc, Get_Actual (Assoc)); + Set_Chain (N_Assoc, Get_Chain (Assoc)); + Set_Associated_Interface (N_Assoc, Inter); + Set_Whole_Association_Flag (N_Assoc, True); + Free_Iir (Assoc); + return N_Assoc; + end Rewrite_Non_Object_Association; + + function Extract_Non_Object_Association + (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir + is + Inter : Iir; + Assoc : Iir; + -- N_Assoc : Iir; + Prev_Assoc : Iir; + Formal : Iir; + Res : Iir; + begin + Inter := Inter_Chain; + Assoc := Assoc_Chain; + Prev_Assoc := Null_Iir; + Res := Null_Iir; + + -- Common case: only objects in interfaces. + while Inter /= Null_Iir loop + exit when Get_Kind (Inter) + not in Iir_Kinds_Interface_Object_Declaration; + Inter := Get_Chain (Inter); + end loop; + if Inter = Null_Iir then + return Assoc_Chain; + end if; + + loop + -- Don't try to detect errors. + if Assoc = Null_Iir then + return Res; + end if; + + Formal := Get_Formal (Assoc); + if Formal = Null_Iir then + -- Positional association. + + if Inter = Null_Iir then + -- But after a named one. Be silent on that error. + null; + elsif Get_Kind (Inter) + not in Iir_Kinds_Interface_Object_Declaration + then + Assoc := Rewrite_Non_Object_Association (Assoc, Inter); + end if; + else + if Get_Kind (Formal) = Iir_Kind_Simple_Name then + -- A candidate. Search the corresponding interface. + Inter := Find_Name_In_Chain + (Inter_Chain, Get_Identifier (Formal)); + if Inter /= Null_Iir + and then + Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration + then + Assoc := Rewrite_Non_Object_Association (Assoc, Inter); + end if; + end if; + + -- No more association by position. + Inter := Null_Iir; + end if; + + if Prev_Assoc = Null_Iir then + Res := Assoc; + else + Set_Chain (Prev_Assoc, Assoc); + end if; + Prev_Assoc := Assoc; + Assoc := Get_Chain (Assoc); + end loop; + end Extract_Non_Object_Association; + -- Semantize all arguments of ASSOC_CHAIN -- Return TRUE if no error. function Sem_Actual_Of_Association_Chain (Assoc_Chain : Iir) @@ -49,10 +140,11 @@ package body Sem_Assocs is Has_Named := True; -- FIXME: check FORMAL is well composed. elsif Has_Named then + -- FIXME: do the check in parser. Error_Msg_Sem ("positional argument after named argument", Assoc); Ok := False; end if; - if Get_Kind (Assoc) /= Iir_Kind_Association_Element_Open then + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then Res := Sem_Expression_Ov (Get_Actual (Assoc), Null_Iir); if Res = Null_Iir then Ok := False; @@ -136,13 +228,13 @@ package body Sem_Assocs is end if; case Get_Kind (Formal_Inter) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => -- LRM93 2.1.1 -- In a subprogram call, the actual designator -- associated with a formal parameter of class -- signal must be a signal. case Get_Kind (Prefix) is - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kinds_Signal_Attribute => @@ -166,7 +258,7 @@ package body Sem_Assocs is end case; case Get_Kind (Prefix) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Check_Parameter_Association_Restriction (Formal_Inter, Prefix, Assoc); when Iir_Kind_Guard_Signal_Declaration => @@ -198,19 +290,19 @@ package body Sem_Assocs is Error_Msg_Sem ("conversion are not allowed for " & "signal parameters", Assoc); end if; - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => -- LRM93 2.1.1 -- The actual designator associated with a formal of -- class variable must be a variable. case Get_Kind (Prefix) is - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => Check_Parameter_Association_Restriction (Formal_Inter, Prefix, Assoc); when Iir_Kind_Variable_Declaration | Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference => null; - when Iir_Kind_File_Interface_Declaration + when Iir_Kind_Interface_File_Declaration | Iir_Kind_File_Declaration => -- LRM87 4.3.1.4 -- Such an object is a member of the variable @@ -223,16 +315,16 @@ package body Sem_Assocs is Error_Msg_Sem ("variable parameter must be a variable", Assoc); end case; - when Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_File_Declaration => -- LRM93 2.1.1 -- The actual designator associated with a formal -- of class file must be a file. case Get_Kind (Prefix) is - when Iir_Kind_File_Interface_Declaration + when Iir_Kind_Interface_File_Declaration | Iir_Kind_File_Declaration => null; when Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration => + | Iir_Kind_Interface_Variable_Declaration => if Flags.Vhdl_Std >= Vhdl_93 then Error_Msg_Sem ("in vhdl93, file parameter " & "must be a file", Assoc); @@ -253,7 +345,7 @@ package body Sem_Assocs is Error_Msg_Sem ("conversion are not allowed for " & "file parameters", Assoc); end if; - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => -- LRM93 2.1.1 -- The actual designator associated with a formal of -- class constant must be an expression. @@ -302,8 +394,8 @@ package body Sem_Assocs is -- Check for restrictions in LRM 1.1.1.2 -- Return FALSE in case of error. function Check_Port_Association_Restriction - (Formal : Iir_Signal_Interface_Declaration; - Actual : Iir_Signal_Interface_Declaration; + (Formal : Iir_Interface_Signal_Declaration; + Actual : Iir_Interface_Signal_Declaration; Assoc : Iir) return Boolean is @@ -368,12 +460,17 @@ package body Sem_Assocs is goto Found; end if; when Iir_Kind_Choice_By_Range => - if Eval_Int_In_Range (Eval_Pos (Index), - Get_Choice_Range (Choice)) - then - -- FIXME: overlap. - raise Internal_Error; - end if; + declare + Choice_Range : constant Iir := Get_Choice_Range (Choice); + begin + if Get_Expr_Staticness (Choice_Range) = Locally + and then + Eval_Int_In_Range (Eval_Pos (Index), Choice_Range) + then + -- FIXME: overlap. + raise Internal_Error; + end if; + end; when others => Error_Kind ("add_individual_assoc_index_name", Choice); end case; @@ -419,8 +516,10 @@ package body Sem_Assocs is Index := Get_Suffix (Formal); -- Evaluate index. - Index := Eval_Range (Index); - Set_Suffix (Formal, Index); + if Get_Expr_Staticness (Index) = Locally then + Index := Eval_Range (Index); + Set_Suffix (Formal, Index); + end if; Choice := Create_Iir (Iir_Kind_Choice_By_Range); Location_Copy (Choice, Formal); @@ -457,7 +556,7 @@ package body Sem_Assocs is | Iir_Kind_Slice_Name | Iir_Kind_Selected_Element => Add_Individual_Association_1 (Iassoc, Get_Prefix (Formal_Object)); - when Iir_Kinds_Interface_Declaration => + when Iir_Kinds_Interface_Object_Declaration => return; when others => Error_Kind ("add_individual_association_1", Formal); @@ -1178,59 +1277,142 @@ package body Sem_Assocs is return Res; end Extract_Out_Conversion; - -- Associate ASSOC with interface INTERFACE - -- This sets MATCH. - procedure Sem_Association + procedure Sem_Association_Open (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Boolean) is Formal : Iir; - Formal_Type : Iir; - Actual: Iir; - Out_Conv, In_Conv : Iir; - Expr : Iir; - Res_Type : Iir; Assoc_Kind : Param_Assoc_Type; begin Formal := Get_Formal (Assoc); - -- Handle open association. - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - if Formal /= Null_Iir then - Assoc_Kind := Sem_Formal (Formal, Inter); - if Assoc_Kind = None then + if Formal /= Null_Iir then + Assoc_Kind := Sem_Formal (Formal, Inter); + if Assoc_Kind = None then + Match := False; + return; + end if; + Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole); + if Finish then + Sem_Name (Formal); + Formal := Finish_Sem_Name (Formal); + Set_Formal (Assoc, Formal); + if Get_Kind (Formal) in Iir_Kinds_Denoting_Name + and then Is_Error (Get_Named_Entity (Formal)) + then Match := False; return; end if; - Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole); - if Finish then - Sem_Name (Formal); - Formal := Finish_Sem_Name (Formal); - Set_Formal (Assoc, Formal); - if Get_Kind (Formal) in Iir_Kinds_Denoting_Name - and then Is_Error (Get_Named_Entity (Formal)) - then - Match := False; - return; - end if; - -- LRM 4.3.3.2 Associations lists - -- It is an error if an actual of open is associated with a - -- formal that is associated individually. - if Assoc_Kind = Individual then - Error_Msg_Sem ("cannot associate individually with open", - Assoc); - end if; + -- LRM 4.3.3.2 Associations lists + -- It is an error if an actual of open is associated with a + -- formal that is associated individually. + if Assoc_Kind = Individual then + Error_Msg_Sem ("cannot associate individually with open", + Assoc); end if; - else - Set_Whole_Association_Flag (Assoc, True); end if; - Match := True; + else + Set_Whole_Association_Flag (Assoc, True); + end if; + Match := True; + end Sem_Association_Open; + + procedure Sem_Association_Package + (Assoc : Iir; + Inter : Iir; + Finish : Boolean; + Match : out Boolean) + is + Formal : constant Iir := Get_Formal (Assoc); + Actual : Iir; + Package_Inter : Iir; + begin + if not Finish then + Match := Get_Associated_Interface (Assoc) = Inter; + return; + end if; + + -- Always match (as this is a generic association, there is no + -- need to resolve overload). + pragma Assert (Get_Associated_Interface (Assoc) = Inter); + Match := True; + + if Formal /= Null_Iir then + pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name); + pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter)); + Set_Named_Entity (Formal, Inter); + Set_Base_Name (Formal, Inter); + end if; + + -- Analyze actual. + Actual := Get_Actual (Assoc); + Actual := Sem_Denoting_Name (Actual); + Set_Actual (Assoc, Actual); + + Actual := Get_Named_Entity (Actual); + if Is_Error (Actual) then + return; + end if; + + -- LRM08 6.5.7.2 Generic map aspects + -- An actual associated with a formal generic package in a + -- generic map aspect shall be the name that denotes an instance + -- of the uninstantiated package named in the formal generic + -- package declaration [...] + if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then + Error_Msg_Sem + ("actual of association is not a package instantiation", Assoc); + return; + end if; + + Package_Inter := + Get_Named_Entity (Get_Uninstantiated_Package_Name (Inter)); + if Get_Named_Entity (Get_Uninstantiated_Package_Name (Actual)) + /= Package_Inter + then + Error_Msg_Sem + ("actual package name is not an instance of interface package", + Assoc); return; end if; + -- LRM08 6.5.7.2 Generic map aspects + -- b) If the formal generic package declaration includes an interface + -- generic map aspect in the form that includes the box (<>) symbol, + -- then the instantiaed package denotes by the actual may be any + -- instance of the uninstantiated package named in the formal + -- generic package declaration. + if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then + null; + else + -- Other cases not yet handled. + raise Internal_Error; + end if; + + return; + end Sem_Association_Package; + + -- Associate ASSOC with interface INTERFACE + -- This sets MATCH. + procedure Sem_Association_By_Expression + (Assoc : Iir; + Inter : Iir; + Finish : Boolean; + Match : out Boolean) + is + Formal : Iir; + Formal_Type : Iir; + Actual: Iir; + Out_Conv, In_Conv : Iir; + Expr : Iir; + Res_Type : Iir; + Assoc_Kind : Param_Assoc_Type; + begin + Formal := Get_Formal (Assoc); + -- Pre-semantize formal and extract out conversion. if Formal /= Null_Iir then Assoc_Kind := Sem_Formal (Formal, Inter); @@ -1252,7 +1434,7 @@ package body Sem_Assocs is -- Extract conversion from actual. Actual := Get_Actual (Assoc); In_Conv := Null_Iir; - if Get_Kind (Inter) /= Iir_Kind_Constant_Interface_Declaration then + if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then case Get_Kind (Actual) is when Iir_Kind_Function_Call => Expr := Get_Parameter_Association_Chain (Actual); @@ -1403,6 +1585,26 @@ package body Sem_Assocs is end if; end if; end if; + end Sem_Association_By_Expression; + + -- Associate ASSOC with interface INTERFACE + -- This sets MATCH. + procedure Sem_Association + (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Boolean) is + begin + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_Open => + Sem_Association_Open (Assoc, Inter, Finish, Match); + + when Iir_Kind_Association_Element_Package => + Sem_Association_Package (Assoc, Inter, Finish, Match); + + when Iir_Kind_Association_Element_By_Expression => + Sem_Association_By_Expression (Assoc, Inter, Finish, Match); + + when others => + Error_Kind ("sem_assocation", Assoc); + end case; end Sem_Association; procedure Sem_Association_Chain @@ -1609,7 +1811,7 @@ package body Sem_Assocs is return; end if; - -- LRM 8.6 Procedure Call Statement + -- LRM93 8.6 Procedure Call Statement -- For each formal parameter of a procedure, a procedure call must -- specify exactly one corresponding actual parameter. -- This actual parameter is specified either explicitly, by an @@ -1617,7 +1819,7 @@ package body Sem_Assocs is -- list, or in the absence of such an association element, by a default -- expression (see Section 4.3.3.2). - -- LRM 7.3.3 Function Calls + -- LRM93 7.3.3 Function Calls -- For each formal parameter of a function, a function call must -- specify exactly one corresponding actual parameter. -- This actual parameter is specified either explicitly, by an @@ -1625,61 +1827,77 @@ package body Sem_Assocs is -- list, or in the absence of such an association element, by a default -- expression (see Section 4.3.3.2). - -- LRM 1.1.1.2 + -- LRM93 1.1.1.2 / LRM08 6.5.6.3 Port clauses -- A port of mode IN may be unconnected or unassociated only if its -- declaration includes a default expression. -- It is an error if a port of any mode other than IN is unconnected -- or unassociated and its type is an unconstrained array type. + -- LRM08 6.5.6.2 Generic clauses + -- It is an error if no such actual [instantiated package] is specified + -- for a given formal generic package (either because the formal generic + -- is unassociated or because the actual is OPEN). + Inter := Interface_Chain; Pos := 0; while Inter /= Null_Iir loop - if Arg_Matched (Pos) <= Open - and then Get_Default_Value (Inter) = Null_Iir - then - case Missing is - when Missing_Parameter - | Missing_Generic => - if Finish then - Error_Msg_Sem ("no actual for " & Disp_Node (Inter), Loc); - end if; - Match := False; - return; - when Missing_Port => - case Get_Mode (Inter) is - when Iir_In_Mode => - if not Finish then - raise Internal_Error; - end if; - Error_Msg_Sem (Disp_Node (Inter) - & " of mode IN must be connected", Loc); - Match := False; - return; - when Iir_Out_Mode - | Iir_Linkage_Mode - | Iir_Inout_Mode - | Iir_Buffer_Mode => - if not Finish then - raise Internal_Error; - end if; - if not Is_Fully_Constrained_Type (Get_Type (Inter)) - then - Error_Msg_Sem - ("unconstrained " & Disp_Node (Inter) - & " must be connected", Loc); + if Arg_Matched (Pos) <= Open then + case Get_Kind (Inter) is + when Iir_Kinds_Interface_Object_Declaration => + if Get_Default_Value (Inter) = Null_Iir then + case Missing is + when Missing_Parameter + | Missing_Generic => + if Finish then + Error_Msg_Sem + ("no actual for " & Disp_Node (Inter), Loc); + end if; Match := False; return; - end if; - when Iir_Unknown_Mode => - raise Internal_Error; - end case; - when Missing_Allowed => - null; + when Missing_Port => + case Get_Mode (Inter) is + when Iir_In_Mode => + if not Finish then + raise Internal_Error; + end if; + Error_Msg_Sem + (Disp_Node (Inter) + & " of mode IN must be connected", Loc); + Match := False; + return; + when Iir_Out_Mode + | Iir_Linkage_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode => + if not Finish then + raise Internal_Error; + end if; + if not Is_Fully_Constrained_Type + (Get_Type (Inter)) + then + Error_Msg_Sem + ("unconstrained " & Disp_Node (Inter) + & " must be connected", Loc); + Match := False; + return; + end if; + when Iir_Unknown_Mode => + raise Internal_Error; + end case; + when Missing_Allowed => + null; + end case; + end if; + when Iir_Kind_Interface_Package_Declaration => + Error_Msg_Sem + (Disp_Node (Inter) & " must be associated", Loc); + Match := False; + when others => + Error_Kind ("sem_association_chain", Inter); end case; end if; Inter := Get_Chain (Inter); Pos := Pos + 1; end loop; - return; end Sem_Association_Chain; end Sem_Assocs; diff --git a/sem_assocs.ads b/sem_assocs.ads index 3b5a884..ec460e0 100644 --- a/sem_assocs.ads +++ b/sem_assocs.ads @@ -18,6 +18,11 @@ with Iirs; use Iirs; package Sem_Assocs is + -- Change the kind of association corresponding to non-object interfaces. + -- Such an association mustn't be handled an like association for object. + function Extract_Non_Object_Association + (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir; + -- Semantize actuals of ASSOC_CHAIN. -- Check all named associations are after positionnal one. -- Return TRUE if no error. @@ -48,8 +53,8 @@ package Sem_Assocs is -- Check for restrictions in §1.1.1.2 -- Return FALSE in case of error. function Check_Port_Association_Restriction - (Formal : Iir_Signal_Interface_Declaration; - Actual : Iir_Signal_Interface_Declaration; + (Formal : Iir_Interface_Signal_Declaration; + Actual : Iir_Interface_Signal_Declaration; Assoc : Iir) return Boolean; end Sem_Assocs; diff --git a/sem_decls.adb b/sem_decls.adb index f864768..a7c0b4b 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -32,6 +32,7 @@ with Sem_Scopes; use Sem_Scopes; with Sem_Names; use Sem_Names; with Sem_Specs; use Sem_Specs; with Sem_Types; use Sem_Types; +with Sem_Inst; with Xrefs; use Xrefs; use Iir_Chains; @@ -65,240 +66,275 @@ package body Sem_Decls is end if; end Check_Signal_Type; - procedure Sem_Interface_Chain (Interface_Chain: Iir; - Interface_Kind : Interface_Kind_Type) + procedure Sem_Interface_Object_Declaration + (Inter, Last : Iir; Interface_Kind : Interface_Kind_Type) is - El, A_Type: Iir; + A_Type: Iir; Default_Value: Iir; - - -- LAST is the last interface declaration that has a type. This is - -- used to set type and default value for the following declarations - -- that appeared in a list of identifiers. - Last : Iir; begin - Last := Null_Iir; - - El := Interface_Chain; - while El /= Null_Iir loop - -- Avoid the reanalysed duplicated types. - -- This is not an optimization, since the unanalysed type must have - -- been freed. - A_Type := Get_Subtype_Indication (El); - if A_Type = Null_Iir then - pragma Assert (Last /= Null_Iir); - Set_Subtype_Indication (El, Get_Subtype_Indication (Last)); - A_Type := Get_Type (Last); - Default_Value := Get_Default_Value (Last); - else - Last := El; - A_Type := Sem_Subtype_Indication (A_Type); - Set_Subtype_Indication (El, A_Type); - A_Type := Get_Type_Of_Subtype_Indication (A_Type); - - Default_Value := Get_Default_Value (El); - if Default_Value /= Null_Iir and then A_Type /= Null_Iir then - Deferred_Constant_Allowed := True; - Default_Value := Sem_Expression (Default_Value, A_Type); - Default_Value := - Eval_Expr_Check_If_Static (Default_Value, A_Type); - Deferred_Constant_Allowed := False; - Check_Read (Default_Value); - end if; + -- Avoid the reanalysed duplicated types. + -- This is not an optimization, since the unanalysed type must have + -- been freed. + A_Type := Get_Subtype_Indication (Inter); + if A_Type = Null_Iir then + pragma Assert (Last /= Null_Iir); + Set_Subtype_Indication (Inter, Get_Subtype_Indication (Last)); + A_Type := Get_Type (Last); + Default_Value := Get_Default_Value (Last); + else + A_Type := Sem_Subtype_Indication (A_Type); + Set_Subtype_Indication (Inter, A_Type); + A_Type := Get_Type_Of_Subtype_Indication (A_Type); + + Default_Value := Get_Default_Value (Inter); + if Default_Value /= Null_Iir and then A_Type /= Null_Iir then + Deferred_Constant_Allowed := True; + Default_Value := Sem_Expression (Default_Value, A_Type); + Default_Value := + Eval_Expr_Check_If_Static (Default_Value, A_Type); + Deferred_Constant_Allowed := False; + Check_Read (Default_Value); end if; + end if; - Set_Name_Staticness (El, Locally); - Xref_Decl (El); - - if A_Type /= Null_Iir then - Set_Type (El, A_Type); + Set_Name_Staticness (Inter, Locally); + Xref_Decl (Inter); - if Get_Kind (El) = Iir_Kind_Signal_Interface_Declaration then - case Get_Signal_Kind (El) is - when Iir_No_Signal_Kind => - null; - when Iir_Bus_Kind => - -- FIXME: where this test came from ? - -- FIXME: from 4.3.1.2 ? - if False - and - (Get_Kind (A_Type) not in Iir_Kinds_Subtype_Definition - or else Get_Resolution_Indication (A_Type) = Null_Iir) - then - Error_Msg_Sem - (Disp_Node (A_Type) - & " of guarded " & Disp_Node (El) - & " is not resolved", El); - end if; + if A_Type /= Null_Iir then + Set_Type (Inter, A_Type); - -- LRM 2.1.1.2 Signal parameter - -- It is an error if the declaration of a formal signal - -- parameter includes the reserved word BUS. - if Flags.Vhdl_Std >= Vhdl_93 - and then Interface_Kind in Parameter_Kind_Subtype - then - Error_Msg_Sem ("signal parameter can't be of kind bus", - El); - end if; - when Iir_Register_Kind => + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then + case Get_Signal_Kind (Inter) is + when Iir_No_Signal_Kind => + null; + when Iir_Bus_Kind => + -- FIXME: where this test came from ? + -- FIXME: from 4.3.1.2 ? + if False + and + (Get_Kind (A_Type) not in Iir_Kinds_Subtype_Definition + or else Get_Resolution_Indication (A_Type) = Null_Iir) + then Error_Msg_Sem - ("interface signal can't be of kind register", El); - end case; - Set_Type_Has_Signal (A_Type); - end if; + (Disp_Node (A_Type) & " of guarded " & Disp_Node (Inter) + & " is not resolved", Inter); + end if; - case Get_Kind (El) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration => - -- LRM 4.3.2 Interface declarations - -- For an interface constant declaration or an interface - -- signal declaration, the subtype indication must define - -- a subtype that is neither a file type, an access type, - -- nor a protected type. Moreover, the subtype indication - -- must not denote a composite type with a subelement that - -- is a file type, an access type, or a protected type. - Check_Signal_Type (El); - when Iir_Kind_Variable_Interface_Declaration => - case Get_Kind (Get_Base_Type (A_Type)) is - when Iir_Kind_File_Type_Definition => - if Flags.Vhdl_Std >= Vhdl_93 then - Error_Msg_Sem ("variable formal type can't be a " - & "file type (vhdl 93)", El); - end if; - when Iir_Kind_Protected_Type_Declaration => - -- LRM 2.1.1.1 Constant and variable parameters - -- It is an error if the mode of the parameter is - -- other that INOUT. - if Get_Mode (El) /= Iir_Inout_Mode then - Error_Msg_Sem - ("parameter of protected type must be inout", El); - end if; - when others => - null; - end case; - when Iir_Kind_File_Interface_Declaration => - if Get_Kind (Get_Base_Type (A_Type)) - /= Iir_Kind_File_Type_Definition + -- LRM 2.1.1.2 Signal parameter + -- It is an error if the declaration of a formal signal + -- parameter includes the reserved word BUS. + if Flags.Vhdl_Std >= Vhdl_93 + and then Interface_Kind in Parameter_Interface_List then Error_Msg_Sem - ("file formal type must be a file type", El); + ("signal parameter can't be of kind bus", Inter); end if; - when others => - -- El is not an interface. - raise Internal_Error; + when Iir_Register_Kind => + Error_Msg_Sem + ("interface signal can't be of kind register", Inter); end case; + Set_Type_Has_Signal (A_Type); + end if; - if Default_Value /= Null_Iir then - Set_Default_Value (El, Default_Value); - - -- LRM 4.3.2 Interface declarations. - -- It is an error if a default expression appears in an - -- interface declaration and any of the following conditions - -- hold: - -- - The mode is linkage - -- - The interface object is a formal signal parameter - -- - The interface object is a formal variable parameter of - -- mode other than in - -- - The subtype indication of the interface declaration - -- denotes a protected type. - case Get_Kind (El) is - when Iir_Kind_Constant_Interface_Declaration => - null; - when Iir_Kind_Signal_Interface_Declaration => - if Get_Mode (El) = Iir_Linkage_Mode then - Error_Msg_Sem - ("default expression not allowed for linkage port", - El); - elsif Interface_Kind in Parameter_Kind_Subtype then - Error_Msg_Sem ("default expression not allowed" - & " for signal parameter", El); + case Get_Kind (Inter) is + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Signal_Declaration => + -- LRM 4.3.2 Interface declarations + -- For an interface constant declaration or an interface + -- signal declaration, the subtype indication must define + -- a subtype that is neither a file type, an access type, + -- nor a protected type. Moreover, the subtype indication + -- must not denote a composite type with a subelement that + -- is a file type, an access type, or a protected type. + Check_Signal_Type (Inter); + when Iir_Kind_Interface_Variable_Declaration => + case Get_Kind (Get_Base_Type (A_Type)) is + when Iir_Kind_File_Type_Definition => + if Flags.Vhdl_Std >= Vhdl_93 then + Error_Msg_Sem ("variable formal type can't be a " + & "file type (vhdl 93)", Inter); end if; - when Iir_Kind_Variable_Interface_Declaration => - if Get_Mode (El) /= Iir_In_Mode then - Error_Msg_Sem ("default expression not allowed for" - & " out/inout variable parameter", El); - elsif Get_Kind (A_Type) - = Iir_Kind_Protected_Type_Declaration - then + when Iir_Kind_Protected_Type_Declaration => + -- LRM 2.1.1.1 Constant and variable parameters + -- It is an error if the mode of the parameter is + -- other that INOUT. + if Get_Mode (Inter) /= Iir_Inout_Mode then Error_Msg_Sem - ("default expression not allowed for" - & " variable parameter of protected type", El); + ("parameter of protected type must be inout", Inter); end if; - when Iir_Kind_File_Interface_Declaration => - raise Internal_Error; when others => null; end case; - end if; - else - Set_Type (El, Error_Type); + when Iir_Kind_Interface_File_Declaration => + if Get_Kind (Get_Base_Type (A_Type)) + /= Iir_Kind_File_Type_Definition + then + Error_Msg_Sem + ("file formal type must be a file type", Inter); + end if; + when others => + -- Inter is not an interface. + raise Internal_Error; + end case; + + if Default_Value /= Null_Iir then + Set_Default_Value (Inter, Default_Value); + + -- LRM 4.3.2 Interface declarations. + -- It is an error if a default expression appears in an + -- interface declaration and any of the following conditions + -- hold: + -- - The mode is linkage + -- - The interface object is a formal signal parameter + -- - The interface object is a formal variable parameter of + -- mode other than in + -- - The subtype indication of the interface declaration + -- denotes a protected type. + case Get_Kind (Inter) is + when Iir_Kind_Interface_Constant_Declaration => + null; + when Iir_Kind_Interface_Signal_Declaration => + if Get_Mode (Inter) = Iir_Linkage_Mode then + Error_Msg_Sem + ("default expression not allowed for linkage port", + Inter); + elsif Interface_Kind in Parameter_Interface_List then + Error_Msg_Sem ("default expression not allowed" + & " for signal parameter", Inter); + end if; + when Iir_Kind_Interface_Variable_Declaration => + if Get_Mode (Inter) /= Iir_In_Mode then + Error_Msg_Sem + ("default expression not allowed for" + & " out or inout variable parameter", Inter); + elsif Get_Kind (A_Type) = Iir_Kind_Protected_Type_Declaration + then + Error_Msg_Sem + ("default expression not allowed for" + & " variable parameter of protected type", Inter); + end if; + when Iir_Kind_Interface_File_Declaration => + raise Internal_Error; + when others => + null; + end case; end if; + else + Set_Type (Inter, Error_Type); + end if; - Sem_Scopes.Add_Name (El); + Sem_Scopes.Add_Name (Inter); - -- By default, interface are not static. - -- This may be changed just below. - Set_Expr_Staticness (El, None); + -- By default, interface are not static. + -- This may be changed just below. + Set_Expr_Staticness (Inter, None); - case Interface_Kind is - when Interface_Generic => - -- LRM93 1.1.1 - -- The generic list in the formal generic clause defines - -- generic constants whose values may be determined by the - -- environment. - if Get_Kind (El) /= Iir_Kind_Constant_Interface_Declaration then - Error_Msg_Sem - ("generic " & Disp_Node (El) & " must be a constant", - El); - else - -- LRM93 7.4.2 (Globally static primaries) - -- 3. a generic constant. - Set_Expr_Staticness (El, Globally); - end if; - when Interface_Port => - if Get_Kind (El) /= Iir_Kind_Signal_Interface_Declaration then - Error_Msg_Sem - ("port " & Disp_Node (El) & " must be a signal", El); - end if; - when Interface_Procedure - | Interface_Function => - if Get_Kind (El) = Iir_Kind_Variable_Interface_Declaration - and then Interface_Kind = Interface_Function - then - Error_Msg_Sem ("variable interface parameter are not " - & "allowed for a function (use a constant)", - El); - end if; + case Interface_Kind is + when Generic_Interface_List => + -- LRM93 1.1.1 + -- The generic list in the formal generic clause defines + -- generic constants whose values may be determined by the + -- environment. + if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then + Error_Msg_Sem + ("generic " & Disp_Node (Inter) & " must be a constant", + Inter); + else + -- LRM93 7.4.2 (Globally static primaries) + -- 3. a generic constant. + Set_Expr_Staticness (Inter, Globally); + end if; + when Port_Interface_List => + if Get_Kind (Inter) /= Iir_Kind_Interface_Signal_Declaration then + Error_Msg_Sem + ("port " & Disp_Node (Inter) & " must be a signal", Inter); + end if; + when Parameter_Interface_List => + if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration + and then Interface_Kind = Function_Parameter_Interface_List + then + Error_Msg_Sem ("variable interface parameter are not " + & "allowed for a function (use a constant)", + Inter); + end if; - -- By default, we suppose a subprogram read the activity of - -- a signal. - -- This will be adjusted when the body is analyzed. - if Get_Kind (El) = Iir_Kind_Signal_Interface_Declaration - and then Get_Mode (El) in Iir_In_Modes - then - Set_Has_Active_Flag (El, True); - end if; + -- By default, we suppose a subprogram read the activity of + -- a signal. + -- This will be adjusted when the body is analyzed. + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration + and then Get_Mode (Inter) in Iir_In_Modes + then + Set_Has_Active_Flag (Inter, True); + end if; - case Get_Mode (El) is - when Iir_Unknown_Mode => - raise Internal_Error; - when Iir_In_Mode => - null; - when Iir_Inout_Mode - | Iir_Out_Mode => - if Interface_Kind = Interface_Function - and then - Get_Kind (El) /= Iir_Kind_File_Interface_Declaration - then - Error_Msg_Sem ("mode of a function parameter cannot " - & "be inout or out", El); - end if; - when Iir_Buffer_Mode - | Iir_Linkage_Mode => - Error_Msg_Sem ("buffer or linkage mode is not allowed " - & "for a subprogram parameter", El); - end case; + case Get_Mode (Inter) is + when Iir_Unknown_Mode => + raise Internal_Error; + when Iir_In_Mode => + null; + when Iir_Inout_Mode + | Iir_Out_Mode => + if Interface_Kind = Function_Parameter_Interface_List + and then + Get_Kind (Inter) /= Iir_Kind_Interface_File_Declaration + then + Error_Msg_Sem ("mode of a function parameter cannot " + & "be inout or out", Inter); + end if; + when Iir_Buffer_Mode + | Iir_Linkage_Mode => + Error_Msg_Sem ("buffer or linkage mode is not allowed " + & "for a subprogram parameter", Inter); + end case; + end case; + end Sem_Interface_Object_Declaration; + + procedure Sem_Interface_Package_Declaration (Inter : Iir) + is + Pkg : Iir; + begin + -- LRM08 6.5.5 Interface package declarations + -- the uninstantiated_package_name shall denote an uninstantiated + -- package declared in a package declaration. + Pkg := Sem_Uninstantiated_Package_Name (Inter); + if Pkg = Null_Iir then + return; + end if; + + Sem_Inst.Instantiate_Package_Declaration (Inter, Pkg); + + if Get_Generic_Map_Aspect_Chain (Inter) /= Null_Iir then + -- TODO + raise Internal_Error; + end if; + + Sem_Scopes.Add_Name (Inter); + end Sem_Interface_Package_Declaration; + + procedure Sem_Interface_Chain (Interface_Chain: Iir; + Interface_Kind : Interface_Kind_Type) + is + Inter : Iir; + + -- LAST is the last interface declaration that has a type. This is + -- used to set type and default value for the following declarations + -- that appeared in a list of identifiers. + Last : Iir; + begin + Last := Null_Iir; + + Inter := Interface_Chain; + while Inter /= Null_Iir loop + case Get_Kind (Inter) is + when Iir_Kinds_Interface_Object_Declaration => + Sem_Interface_Object_Declaration (Inter, Last, Interface_Kind); + Last := Inter; + when Iir_Kind_Interface_Package_Declaration => + Sem_Interface_Package_Declaration (Inter); + when others => + raise Internal_Error; end case; - El := Get_Chain (El); + Inter := Get_Chain (Inter); end loop; -- LRM 10.3 Visibility @@ -312,10 +348,10 @@ package body Sem_Decls is -- GHDL: this is achieved by making the interface object visible after -- having analyzed the interface list. - El := Interface_Chain; - while El /= Null_Iir loop - Name_Visible (El); - El := Get_Chain (El); + Inter := Interface_Chain; + while Inter /= Null_Iir loop + Name_Visible (Inter); + Inter := Get_Chain (Inter); end loop; end Sem_Interface_Chain; @@ -380,7 +416,7 @@ package body Sem_Decls is Iir_Predefined_File_Open_Status); -- status : out file_open_status. Inter := - Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Create_Iir (Iir_Kind_Interface_Variable_Declaration); Set_Location (Inter, Loc); Set_Identifier (Inter, Std_Names.Name_Status); Set_Type (Inter, @@ -390,7 +426,7 @@ package body Sem_Decls is Append (Last_Interface, Proc, Inter); end case; -- File F : FT - Inter := Create_Iir (Iir_Kind_File_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_File_Declaration); Set_Location (Inter, Loc); Set_Identifier (Inter, Std_Names.Name_F); Set_Type (Inter, Type_Definition); @@ -398,7 +434,7 @@ package body Sem_Decls is Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type); Append (Last_Interface, Proc, Inter); -- External_Name : in STRING - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Set_Location (Inter, Loc); Set_Identifier (Inter, Std_Names.Name_External_Name); Set_Type (Inter, Std_Package.String_Type_Definition); @@ -406,7 +442,7 @@ package body Sem_Decls is Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type); Append (Last_Interface, Proc, Inter); -- Open_Kind : in File_Open_Kind := Read_Mode. - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Set_Location (Inter, Loc); Set_Identifier (Inter, Std_Names.Name_Open_Kind); Set_Type (Inter, Std_Package.File_Open_Kind_Type_Definition); @@ -429,7 +465,7 @@ package body Sem_Decls is Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); Build_Init (Last_Interface); - Inter := Create_Iir (Iir_Kind_File_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_File_Declaration); Set_Identifier (Inter, Std_Names.Name_F); Set_Location (Inter, Loc); Set_Type (Inter, Type_Definition); @@ -442,9 +478,9 @@ package body Sem_Decls is end if; if Flags.Vhdl_Std = Vhdl_87 then - File_Interface_Kind := Iir_Kind_Variable_Interface_Declaration; + File_Interface_Kind := Iir_Kind_Interface_Variable_Declaration; else - File_Interface_Kind := Iir_Kind_File_Interface_Declaration; + File_Interface_Kind := Iir_Kind_Interface_File_Declaration; end if; -- Create the implicit procedure read declaration. @@ -462,7 +498,7 @@ package body Sem_Decls is Set_Mode (Inter, Iir_In_Mode); Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type); Append (Last_Interface, Proc, Inter); - Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Variable_Declaration); Set_Identifier (Inter, Std_Names.Name_Value); Set_Location (Inter, Loc); Set_Subtype_Indication (Inter, Type_Mark); @@ -473,7 +509,7 @@ package body Sem_Decls is if Get_Kind (Type_Mark_Type) in Iir_Kinds_Array_Type_Definition and then Get_Constraint_State (Type_Mark_Type) /= Fully_Constrained then - Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Variable_Declaration); Set_Identifier (Inter, Std_Names.Name_Length); Set_Location (Inter, Loc); Set_Type (Inter, Std_Package.Natural_Subtype_Definition); @@ -505,7 +541,7 @@ package body Sem_Decls is Set_Expr_Staticness (Inter, None); Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type); Append (Last_Interface, Proc, Inter); - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Set_Identifier (Inter, Std_Names.Name_Value); Set_Location (Inter, Loc); Set_Subtype_Indication (Inter, Type_Mark); @@ -563,11 +599,11 @@ package body Sem_Decls is end Create_Implicit_File_Primitives; function Create_Anonymous_Interface (Atype : Iir) - return Iir_Constant_Interface_Declaration + return Iir_Interface_Constant_Declaration is - Inter : Iir_Constant_Interface_Declaration; + Inter : Iir_Interface_Constant_Declaration; begin - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Location_Copy (Inter, Atype); Set_Identifier (Inter, Null_Identifier); Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type); @@ -654,12 +690,12 @@ package body Sem_Decls is procedure Add_Shift_Operators is - Inter_Chain : Iir_Constant_Interface_Declaration; + Inter_Chain : Iir_Interface_Constant_Declaration; Inter_Int : Iir; begin Inter_Chain := Create_Anonymous_Interface (Type_Definition); - Inter_Int := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter_Int := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Location_Copy (Inter_Int, Decl); Set_Identifier (Inter_Int, Null_Identifier); Set_Mode (Inter_Int, Iir_In_Mode); @@ -988,7 +1024,7 @@ package body Sem_Decls is (Name_Op_Inequality, Iir_Predefined_Access_Inequality); declare Deallocate_Proc: Iir_Implicit_Procedure_Declaration; - Var_Interface: Iir_Variable_Interface_Declaration; + Var_Interface: Iir_Interface_Variable_Declaration; begin Deallocate_Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); @@ -996,7 +1032,7 @@ package body Sem_Decls is Set_Implicit_Definition (Deallocate_Proc, Iir_Predefined_Deallocate); Var_Interface := - Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Create_Iir (Iir_Kind_Interface_Variable_Declaration); Set_Identifier (Var_Interface, Std_Names.Name_P); Set_Type (Var_Interface, Type_Definition); Set_Mode (Var_Interface, Iir_Inout_Mode); @@ -1934,8 +1970,10 @@ package body Sem_Decls is -- 6. A component declaration. Open_Declarative_Region; - Sem_Interface_Chain (Get_Generic_Chain (Component), Interface_Generic); - Sem_Interface_Chain (Get_Port_Chain (Component), Interface_Port); + Sem_Interface_Chain + (Get_Generic_Chain (Component), Generic_Interface_List); + Sem_Interface_Chain + (Get_Port_Chain (Component), Port_Interface_List); Close_Declarative_Region; diff --git a/sem_decls.ads b/sem_decls.ads index 5ff2b8b..7a8e240 100644 --- a/sem_decls.ads +++ b/sem_decls.ads @@ -18,12 +18,6 @@ with Iirs; use Iirs; package Sem_Decls is - -- The kind of an inteface list. - type Interface_Kind_Type is (Interface_Generic, Interface_Port, - Interface_Procedure, Interface_Function); - subtype Parameter_Kind_Subtype is - Interface_Kind_Type range Interface_Procedure .. Interface_Function; - procedure Sem_Interface_Chain (Interface_Chain: Iir; Interface_Kind : Interface_Kind_Type); diff --git a/sem_expr.adb b/sem_expr.adb index 309a248..f7af76c 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -315,7 +315,10 @@ package body Sem_Expr is | Iir_Kinds_Subtype_Definition | Iir_Kind_Design_Unit | Iir_Kind_Architecture_Body + | Iir_Kind_Configuration_Declaration | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration | Iir_Kinds_Concurrent_Statement | Iir_Kinds_Sequential_Statement | Iir_Kind_Library_Declaration @@ -885,12 +888,13 @@ package body Sem_Expr is -- Add CALLEE in the callees list of SUBPRG (which must be a subprg decl). procedure Add_In_Callees_List (Subprg : Iir; Callee : Iir) is + Holder : constant Iir := Get_Callees_List_Holder (Subprg); List : Iir_List; begin - List := Get_Callees_List (Subprg); + List := Get_Callees_List (Holder); if List = Null_Iir_List then List := Create_Iir_List; - Set_Callees_List (Subprg, List); + Set_Callees_List (Holder, List); end if; -- FIXME: May use a flag in IMP to speed up the -- add operation. @@ -1010,9 +1014,8 @@ package body Sem_Expr is -- ("(indirect) wait statement not allowed in " & Where, Loc); end Error_Wait; begin - if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then - raise Internal_Error; - end if; + pragma Assert (Get_Kind (Callee) = Iir_Kind_Procedure_Declaration); + case Get_Wait_State (Callee) is when False => return; @@ -1501,14 +1504,14 @@ package body Sem_Expr is Formal := Get_Base_Name (Formal); Inter := Null_Iir; end if; - if Get_Kind (Formal) = Iir_Kind_Signal_Interface_Declaration + if Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration and then Get_Mode (Formal) in Iir_Out_Modes then Prefix := Name_To_Object (Get_Actual (Param)); if Prefix /= Null_Iir then case Get_Kind (Get_Object_Prefix (Prefix)) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => Prefix := Get_Longuest_Static_Prefix (Prefix); Sem_Stmts.Sem_Add_Driver (Prefix, Stmt); when others => @@ -3627,7 +3630,7 @@ package body Sem_Expr is case Get_Kind (Obj) is when Iir_Kind_Signal_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Iterator_Declaration @@ -3636,7 +3639,7 @@ package body Sem_Expr is when Iir_Kinds_Quantity_Declaration => return; when Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_File_Declaration => -- LRM 4.3.2 Interface declarations -- The value of an object is said to be read [...] -- - When the object is a file and a READ operation is @@ -3644,8 +3647,8 @@ package body Sem_Expr is return; when Iir_Kind_Object_Alias_Declaration => Obj := Get_Name (Obj); - when Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration => case Get_Mode (Obj) is when Iir_In_Mode | Iir_Inout_Mode diff --git a/sem_inst.adb b/sem_inst.adb index c368e1f..d636839 100644 --- a/sem_inst.adb +++ b/sem_inst.adb @@ -19,6 +19,7 @@ with Nodes; with Nodes_Meta; with Types; use Types; with Iirs_Utils; use Iirs_Utils; +with Errorout; use Errorout; package body Sem_Inst is -- Table of origin. This is an extension of vhdl nodes to track the @@ -330,7 +331,7 @@ package body Sem_Inst is begin Res := Get_Instance (N); - if Kind = Iir_Kind_Constant_Interface_Declaration + if Kind = Iir_Kind_Interface_Constant_Declaration and then Get_Identifier (N) = Null_Identifier and then Res /= Null_Iir then @@ -355,8 +356,11 @@ package body Sem_Inst is for I in Fields'Range loop F := Fields (I); + -- Fields that are handled specially. case F is when Field_Index_Subtype_List => + -- Index_Subtype_List is always a reference, so retrieve + -- the instance of the referenced list. declare List : Iir_List; begin @@ -389,6 +393,9 @@ package body Sem_Inst is -- Subprogram body is a forward declaration. Set_Subprogram_Body (Res, Null_Iir); when others => + -- TODO: other forward references: + -- incomplete constant + -- attribute_value null; end case; @@ -396,6 +403,213 @@ package body Sem_Inst is end; end Instantiate_Iir; + -- As the scope generic interfaces extends beyond the immediate scope (see + -- LRM08 12.2 Scope of declarations), they must be instantiated. + function Instantiate_Generic_Chain (Inst : Iir; Inters : Iir) return Iir + is + Inter : Iir; + First : Iir; + Last : Iir; + Res : Iir; + begin + First := Null_Iir; + Last := Null_Iir; + + Inter := Inters; + while Inter /= Null_Iir loop + -- Create a copy of the interface. FIXME: is it really needed ? + Res := Create_Iir (Get_Kind (Inter)); + Set_Location (Res, Instantiate_Loc); + Set_Parent (Res, Inst); + Set_Identifier (Res, Get_Identifier (Inter)); + Set_Visible_Flag (Res, Get_Visible_Flag (Inter)); + + Set_Origin (Res, Inter); + Set_Instance (Inter, Res); + + case Get_Kind (Res) is + when Iir_Kind_Interface_Constant_Declaration => + Set_Type (Res, Get_Type (Inter)); + Set_Subtype_Indication (Res, Get_Subtype_Indication (Inter)); + Set_Mode (Res, Get_Mode (Inter)); + Set_Lexical_Layout (Res, Get_Lexical_Layout (Inter)); + Set_Expr_Staticness (Res, Get_Expr_Staticness (Inter)); + Set_Name_Staticness (Res, Get_Name_Staticness (Inter)); + when Iir_Kind_Interface_Package_Declaration => + Set_Uninstantiated_Package_Name + (Res, Get_Uninstantiated_Package_Name (Inter)); + when others => + Error_Kind ("instantiate_generic_chain", Res); + end case; + + -- Append + if First = Null_Iir then + First := Res; + else + Set_Chain (Last, Res); + end if; + Last := Res; + + Inter := Get_Chain (Inter); + end loop; + + return First; + end Instantiate_Generic_Chain; + + procedure Set_Instance_On_Chain (Chain : Iir; Inst_Chain : Iir); + procedure Set_Instance_On_Iir_List (N : Iir_List; Inst : Iir_List); + + procedure Set_Instance_On_Iir (N : Iir; Inst : Iir) is + begin + if N = Null_Iir then + pragma Assert (Inst = Null_Iir); + return; + end if; + pragma Assert (Inst /= Null_Iir); + + declare + use Nodes_Meta; + Kind : constant Iir_Kind := Get_Kind (N); + Fields : constant Fields_Array := Get_Fields (Kind); + F : Fields_Enum; + begin + pragma Assert (Get_Kind (Inst) = Kind); + + if Kind = Iir_Kind_Interface_Constant_Declaration + and then Get_Identifier (N) = Null_Identifier + then + -- Anonymous constant interface declarations are the only nodes + -- that can be shared. Handle that very special case. + return; + end if; + + -- pragma Assert (Get_Instance (N) = Null_Iir); + Set_Instance (N, Inst); + + for I in Fields'Range loop + F := Fields (I); + + case Get_Field_Type (F) is + when Type_Iir => + declare + S : constant Iir := Get_Iir (N, F); + S_Inst : constant Iir := Get_Iir (Inst, F); + begin + case Get_Field_Attribute (F) is + when Attr_None => + Set_Instance_On_Iir (S, S_Inst); + when Attr_Ref => + null; + when Attr_Maybe_Ref => + if not Get_Is_Ref (N) then + Set_Instance_On_Iir (S, S_Inst); + end if; + when Attr_Chain => + Set_Instance_On_Chain (S, S_Inst); + when Attr_Chain_Next => + null; + when Attr_Of_Ref => + -- Can only appear in list. + raise Internal_Error; + end case; + end; + when Type_Iir_List => + declare + S : constant Iir_List := Get_Iir_List (N, F); + S_Inst : constant Iir_List := Get_Iir_List (Inst, F); + begin + case Get_Field_Attribute (F) is + when Attr_None => + Set_Instance_On_Iir_List (S, S_Inst); + when Attr_Of_Ref + | Attr_Ref => + null; + when others => + -- Ref is specially handled in Instantiate_Iir. + -- Others cannot appear for lists. + raise Internal_Error; + end case; + end; + when others => + null; + end case; + end loop; + end; + end Set_Instance_On_Iir; + + procedure Set_Instance_On_Iir_List (N : Iir_List; Inst : Iir_List) + is + El : Iir; + El_Inst : Iir; + begin + case N is + when Null_Iir_List + | Iir_List_All + | Iir_List_Others => + pragma Assert (Inst = N); + return; + when others => + for I in Natural loop + El := Get_Nth_Element (N, I); + El_Inst := Get_Nth_Element (Inst, I); + exit when El = Null_Iir; + pragma Assert (El_Inst /= Null_Iir); + + Set_Instance_On_Iir (El, El_Inst); + end loop; + pragma Assert (El_Inst = Null_Iir); + end case; + end Set_Instance_On_Iir_List; + + procedure Set_Instance_On_Chain (Chain : Iir; Inst_Chain : Iir) + is + El : Iir; + Inst_El : Iir; + begin + El := Chain; + Inst_El := Inst_Chain; + while El /= Null_Iir loop + pragma Assert (Inst_El /= Null_Iir); + Set_Instance_On_Iir (El, Inst_El); + El := Get_Chain (El); + Inst_El := Get_Chain (Inst_El); + end loop; + pragma Assert (Inst_El = Null_Iir); + end Set_Instance_On_Chain; + + -- In the instance, replace references (and inner references) to interface + -- package declaration to the associated package. + procedure Instantiate_Generic_Map_Chain (Inst : Iir; Pkg : Iir) + is + pragma Unreferenced (Pkg); + Assoc : Iir; + begin + Assoc := Get_Generic_Map_Aspect_Chain (Inst); + while Assoc /= Null_Iir loop + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + null; + when Iir_Kind_Association_Element_Package => + declare + Sub_Inst : constant Iir := + Get_Named_Entity (Get_Actual (Assoc)); + Sub_Pkg : constant Iir := Get_Associated_Interface (Assoc); + begin + Set_Instance (Sub_Pkg, Sub_Inst); + Set_Instance_On_Chain (Get_Generic_Chain (Sub_Pkg), + Get_Generic_Chain (Sub_Inst)); + Set_Instance_On_Chain (Get_Declaration_Chain (Sub_Pkg), + Get_Declaration_Chain (Sub_Inst)); + end; + when others => + Error_Kind ("instantiate_generic_map_chain", Assoc); + end case; + Assoc := Get_Chain (Assoc); + end loop; + end Instantiate_Generic_Map_Chain; + procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir) is Header : constant Iir := Get_Package_Header (Pkg); @@ -411,7 +625,8 @@ package body Sem_Inst is Set_Origin (Pkg, Inst); Set_Generic_Chain - (Inst, Instantiate_Iir_Chain (Get_Generic_Chain (Header))); + (Inst, Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Header))); + Instantiate_Generic_Map_Chain (Inst, Pkg); Set_Declaration_Chain (Inst, Instantiate_Iir_Chain (Get_Declaration_Chain (Pkg))); diff --git a/sem_names.adb b/sem_names.adb index 2958753..151e817 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -442,9 +442,8 @@ package body Sem_Names is Prefix := Get_Prefix (Name); Obj := Get_Named_Entity (Prefix); if Obj /= Null_Iir - and then - (Get_Kind (Obj) = Iir_Kind_Variable_Declaration - or Get_Kind (Obj) = Iir_Kind_Variable_Interface_Declaration) + and then Kind_In (Obj, Iir_Kind_Variable_Declaration, + Iir_Kind_Interface_Variable_Declaration) and then Get_Type (Obj) /= Null_Iir then if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration @@ -1247,10 +1246,10 @@ package body Sem_Names is | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_File_Declaration => null; - when Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration => -- When referenced as a formal name (FIXME: this is an -- approximation), the rules don't apply. if not Get_Is_Within_Flag (Get_Parent (Obj)) then @@ -1408,7 +1407,8 @@ package body Sem_Names is | Iir_Kind_Group_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Library_Declaration => + | Iir_Kind_Library_Declaration + | Iir_Kind_Interface_Package_Declaration => Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Base_Name (Name_Res, Res); return Name_Res; @@ -2892,7 +2892,7 @@ package body Sem_Names is end if; Set_Base_Name (Res, Res); - if Get_Kind (Prefix) = Iir_Kind_Signal_Interface_Declaration then + if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then -- LRM93 2.1.1.2 / LRM08 4.2.2.3 -- -- It is an error if signal-valued attributes 'STABLE , 'QUIET, @@ -2923,7 +2923,7 @@ package body Sem_Names is Base := Get_Object_Prefix (Prefix); case Get_Kind (Base) 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 => null; @@ -3032,7 +3032,7 @@ package body Sem_Names is case Get_Kind (Base) is when Iir_Kind_Signal_Declaration => null; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => case Get_Mode (Base) is when Iir_Buffer_Mode | Iir_Inout_Mode @@ -3124,7 +3124,7 @@ package body Sem_Names is | Iir_Kind_Constant_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Component_Declaration | Iir_Kinds_Concurrent_Statement @@ -3137,8 +3137,8 @@ package body Sem_Names is | Iir_Kind_Non_Object_Alias_Declaration => null; - when Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration => if Get_Identifier (Attr) /= Name_Simple_Name and then Get_Kind (Get_Parent (Prefix)) = Iir_Kind_Component_Declaration @@ -3650,10 +3650,10 @@ package body Sem_Names is | Iir_Kind_File_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element @@ -3681,10 +3681,10 @@ package body Sem_Names is | Iir_Kind_File_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element @@ -3744,6 +3744,7 @@ package body Sem_Names is | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Library_Declaration | Iir_Kinds_Subprogram_Declaration | Iir_Kind_Component_Declaration => diff --git a/sem_scopes.adb b/sem_scopes.adb index 6590e48..71c7585 100644 --- a/sem_scopes.adb +++ b/sem_scopes.adb @@ -983,10 +983,11 @@ package body Sem_Scopes is | Iir_Kind_File_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Component_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Group_Template_Declaration @@ -1284,6 +1285,14 @@ package body Sem_Scopes is Add_Package_Declarations (Name, True); when Iir_Kind_Package_Instantiation_Declaration => Add_Package_Instantiation_Declarations (Name, True); + when Iir_Kind_Interface_Package_Declaration => + -- LRM08 6.5.5 Interface package declarations + -- Within an entity declaration, an architecture body, a + -- component declaration, or an uninstantiated subprogram or + -- package declaration that declares a given interface package, + -- the name of the given interface package denotes an undefined + -- instance of the uninstantiated package. + Add_Package_Instantiation_Declarations (Name, True); when Iir_Kind_Error => null; when others => diff --git a/sem_specs.adb b/sem_specs.adb index 4c16a07..ca821b2 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -59,14 +59,14 @@ package body Sem_Specs is when Iir_Kind_Subtype_Declaration => return Tok_Subtype; when Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration => return Tok_Constant; when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => return Tok_Signal; when Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration => + | Iir_Kind_Interface_Variable_Declaration => return Tok_Variable; when Iir_Kind_Component_Declaration => return Tok_Component; @@ -100,7 +100,7 @@ package body Sem_Specs is when Iir_Kind_Group_Declaration => return Tok_Group; when Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration => + | Iir_Kind_Interface_File_Declaration => return Tok_File; when Iir_Kind_Attribute_Declaration => -- Even if an attribute can't have a attribute... @@ -898,7 +898,7 @@ package body Sem_Specs is -- denotes a guarded signal. case Get_Kind (Prefix) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => null; when others => Error_Msg_Sem ("object must be a signal", El); diff --git a/sem_stmts.adb b/sem_stmts.adb index d975807..b5912fb 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -344,7 +344,7 @@ package body Sem_Stmts is Target_Prefix := Get_Object_Prefix (Target_Object); Targ_Obj_Kind := Get_Kind (Target_Prefix); case Targ_Obj_Kind is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then Error_Msg_Sem (Disp_Node (Target_Prefix) & " can't be assigned", Target); @@ -373,7 +373,7 @@ package body Sem_Stmts is -- kind. This is determined at run-time, according to the actual -- associated with the formal. -- GHDL: parent of target cannot be a function. - if Targ_Obj_Kind = Iir_Kind_Signal_Interface_Declaration + if Targ_Obj_Kind = Iir_Kind_Interface_Signal_Declaration and then Get_Kind (Get_Parent (Target_Prefix)) = Iir_Kind_Procedure_Declaration then @@ -414,7 +414,7 @@ package body Sem_Stmts is end if; Target_Prefix := Get_Object_Prefix (Target_Object); case Get_Kind (Target_Prefix) is - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then Error_Msg_Sem (Disp_Node (Target_Prefix) & " cannot be written (bad mode)", Target); @@ -1023,7 +1023,7 @@ package body Sem_Stmts is | Iir_Kind_Guard_Signal_Declaration | Iir_Kinds_Signal_Attribute => null; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => if not Iir_Mode_Readable (Get_Mode (Prefix)) then Error_Msg_Sem (Disp_Node (Res) & " of mode out" @@ -1450,9 +1450,9 @@ package body Sem_Stmts is Header := Get_Block_Header (Stmt); if Header /= Null_Iir then Generic_Chain := Get_Generic_Chain (Header); - Sem_Interface_Chain (Generic_Chain, Interface_Generic); + Sem_Interface_Chain (Generic_Chain, Generic_Interface_List); Port_Chain := Get_Port_Chain (Header); - Sem_Interface_Chain (Port_Chain, Interface_Port); + Sem_Interface_Chain (Port_Chain, Port_Interface_List); -- LRM 9.1 -- Such actuals are evaluated in the context of the enclosing @@ -1619,7 +1619,7 @@ package body Sem_Stmts is -- FIXME. case Get_Kind (Guard) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => null; when others => diff --git a/sem_types.adb b/sem_types.adb index 27eee59..12f276b 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -776,8 +776,6 @@ package body Sem_Types is Set_Type_Staticness (Def, Locally); Set_Signal_Type_Flag (Def, True); - Create_Range_Constraint_For_Enumeration_Type (Def); - -- Makes all literal visible. declare El: Iir; @@ -806,6 +804,8 @@ package body Sem_Types is end; Set_Resolved_Flag (Def, False); + Create_Range_Constraint_For_Enumeration_Type (Def); + -- Identifier IEEE.Std_Logic_1164.Std_Ulogic. if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic and then @@ -1245,7 +1245,7 @@ package body Sem_Types is if Decl = Null_Iir or else Get_Chain (Decl) /= Null_Iir then return False; end if; - if Get_Kind (Decl) /= Iir_Kind_Constant_Interface_Declaration then + if Get_Kind (Decl) /= Iir_Kind_Interface_Constant_Declaration then return False; end if; -- LRM93 2.4 @@ -1370,6 +1370,7 @@ package body Sem_Types is Subtype_Index_List : Iir_List; Resolv_Func : Iir := Null_Iir; Resolv_El : Iir := Null_Iir; + Resolv_Ind : Iir; begin if Resolution /= Null_Iir then -- A resolution indication is present. @@ -1545,8 +1546,19 @@ package body Sem_Types is -- FIXME: may a resolution indication for a record be incomplete ? Set_Resolved_Flag (Res, Get_Resolved_Flag (El_Def)); elsif Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition then - Set_Resolution_Indication - (Res, Get_Resolution_Indication (Type_Mark)); + Resolv_Ind := Get_Resolution_Indication (Type_Mark); + if Resolv_Ind /= Null_Iir then + case Get_Kind (Resolv_Ind) is + when Iir_Kinds_Denoting_Name => + Error_Kind ("sem_array_constraint(resolution)", Resolv_Ind); + when Iir_Kind_Array_Element_Resolution => + -- Already applied to the element. + Resolv_Ind := Null_Iir; + when others => + Error_Kind ("sem_array_constraint(resolution2)", Resolv_Ind); + end case; + Set_Resolution_Indication (Res, Resolv_Ind); + end if; Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark)); end if; diff --git a/std_package.adb b/std_package.adb index ea2a691..1edfb6c 100644 --- a/std_package.adb +++ b/std_package.adb @@ -292,8 +292,8 @@ package body Std_Package is Inter2_Type : Iir := Null_Iir) is Decl : Iir_Implicit_Function_Declaration; - Inter : Iir_Constant_Interface_Declaration; - Inter2 : Iir_Constant_Interface_Declaration; + Inter : Iir_Interface_Constant_Declaration; + Inter2 : Iir_Interface_Constant_Declaration; begin Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); Set_Std_Identifier (Decl, Name); @@ -301,7 +301,7 @@ package body Std_Package is Set_Pure_Flag (Decl, True); Set_Implicit_Definition (Decl, Imp); - Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Set_Identifier (Inter, Std_Names.Name_Value); Set_Type (Inter, Inter_Type); Set_Mode (Inter, Iir_In_Mode); @@ -309,7 +309,7 @@ package body Std_Package is Set_Interface_Declaration_Chain (Decl, Inter); if Inter2_Id /= Null_Identifier then - Inter2 := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Inter2 := Create_Iir (Iir_Kind_Interface_Constant_Declaration); Set_Identifier (Inter2, Inter2_Id); Set_Type (Inter2, Inter2_Type); Set_Mode (Inter2, Iir_In_Mode); @@ -327,7 +327,7 @@ package body Std_Package is (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir) is Decl : Iir_Implicit_Function_Declaration; - Inter : Iir_Constant_Interface_Declaration; + Inter : Iir_Interface_Constant_Declaration; begin Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); Set_Std_Identifier (Decl, Name); @@ -335,7 +335,7 @@ package body Std_Package is Set_Pure_Flag (Decl, True); Set_Implicit_Definition (Decl, Func); - Inter := Create_Iir (Iir_Kind_Signal_Interface_Declaration); + Inter := Create_Iir (Iir_Kind_Interface_Signal_Declaration); Set_Identifier (Inter, Std_Names.Name_S); Set_Type (Inter, Inter_Type); Set_Mode (Inter, Iir_In_Mode); diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb index 73d5ba7..0104000 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -1660,11 +1660,11 @@ package body Ghdlprint is C := 'F'; when Iir_Kind_Procedure_Declaration => C := 'p'; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => C := 's'; when Iir_Kind_Signal_Declaration => C := 'S'; - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => C := 'c'; when Iir_Kind_Constant_Declaration => C := 'C'; diff --git a/translate/trans_analyzes.adb b/translate/trans_analyzes.adb index cf800f0..8147e93 100644 --- a/translate/trans_analyzes.adb +++ b/translate/trans_analyzes.adb @@ -33,7 +33,7 @@ package body Trans_Analyzes is begin Base := Get_Object_Prefix (Target); -- Assigment to subprogram interface does not create a driver. - if Get_Kind (Base) = Iir_Kind_Signal_Interface_Declaration + if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration and then Get_Kind (Get_Parent (Base)) = Iir_Kind_Procedure_Declaration then @@ -92,7 +92,7 @@ package body Trans_Analyzes is if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression and then - Get_Kind (Formal) = Iir_Kind_Signal_Interface_Declaration + Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration and then Get_Mode (Formal) /= Iir_In_Mode then Status := Extract_Driver_Target (Get_Actual (Assoc)); diff --git a/translate/translation.adb b/translate/translation.adb index af703ef..e639809 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -224,6 +224,9 @@ package body Translation is Null_Var_Scope : constant Var_Scope_Type; + type Var_Type is private; + Null_Var : constant Var_Type; + -- Return the record type for SCOPE. function Get_Scope_Type (Scope : Var_Scope_Type) return O_Tnode; @@ -277,21 +280,26 @@ package body Translation is (Scope : in out Var_Scope_Type; Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc); - -- Variables defined in SCOPE_TYPE can be accessed by dereferencing + -- Variables defined in SCOPE can be accessed by dereferencing -- field SCOPE_FIELD defined in SCOPE_PARENT. procedure Set_Scope_Via_Field_Ptr (Scope : in out Var_Scope_Type; Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc); - -- Variables/scopes defined in SCOPE_TYPE can be accessed via + -- Variables/scopes defined in SCOPE can be accessed via -- dereference of parameter SCOPE_PARAM. procedure Set_Scope_Via_Param_Ptr (Scope : in out Var_Scope_Type; Scope_Param : O_Dnode); - -- Variables/scopes defined in SCOPE_TYPE can be accessed via DECL. + -- Variables/scopes defined in SCOPE can be accessed via DECL. procedure Set_Scope_Via_Decl (Scope : in out Var_Scope_Type; Decl : O_Dnode); + -- Variables/scopes defined in SCOPE can be accessed by derefencing + -- VAR. + procedure Set_Scope_Via_Var_Ptr + (Scope : in out Var_Scope_Type; Var : Var_Type); + -- No more accesses to SCOPE_TYPE are allowed. Scopes must be cleared -- before being set. procedure Clear_Scope (Scope : in out Var_Scope_Type); @@ -347,9 +355,6 @@ package body Translation is return Var_Ident_Type; function Create_Uniq_Identifier return Var_Ident_Type; - type Var_Type is private; - Null_Var : constant Var_Type; - -- Create variable NAME of type VTYPE in the current scope. -- If the current scope is the global scope, then a variable is -- created at the top level (using decl_global_storage). @@ -550,6 +555,10 @@ package body Translation is procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir); + -- Add info for an interface_package_declaration or a + -- package_instantiation_declaration + procedure Instantiate_Info_Package (Inst : Iir); + -- Elaborate packages that DESIGN_UNIT depends on (except std.standard). procedure Elab_Dependence (Design_Unit: Iir_Design_Unit); @@ -4873,11 +4882,11 @@ package body Translation is Tinfo : constant Type_Info_Acc := Get_Info (Get_Type (Inter)); begin case Get_Kind (Inter) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_File_Declaration => Mode := Mode_Value; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Mode := Mode_Signal; when others => Error_Kind ("translate_interface_type", Inter); @@ -4970,7 +4979,7 @@ package body Translation is Arg_Info := Add_Info (Inter, Kind_Interface); Inter_Type := Get_Type (Inter); Tinfo := Get_Info (Inter_Type); - if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration + if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration and then Get_Mode (Inter) in Iir_Out_Modes and then Tinfo.Type_Mode not in Type_Mode_By_Ref and then Tinfo.Type_Mode /= Type_Mode_File @@ -5296,7 +5305,7 @@ package body Translation is begin Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop - if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration + if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration and then Get_Mode (Inter) = Iir_Out_Mode then Inter_Type := Get_Type (Inter); @@ -5640,6 +5649,67 @@ package body Translation is end case; end Instantiate_Iir_List_Info; + procedure Copy_Info (Dest : Ortho_Info_Acc; Src : Ortho_Info_Acc) is + begin + case Src.Kind is + when Kind_Type => + Dest.all := (Kind => Kind_Type, + Type_Mode => Src.Type_Mode, + Type_Incomplete => Src.Type_Incomplete, + Type_Locally_Constrained => + Src.Type_Locally_Constrained, + C => null, + Ortho_Type => Src.Ortho_Type, + Ortho_Ptr_Type => Src.Ortho_Ptr_Type, + Type_Transient_Chain => Null_Iir, + T => Src.T, + Type_Rti => Src.Type_Rti); + pragma Assert (Src.C = null); + pragma Assert (Src.Type_Transient_Chain = Null_Iir); + when Kind_Object => + pragma Assert (Src.Object_Driver = Null_Var); + pragma Assert (Src.Object_Function = O_Dnode_Null); + Dest.all := + (Kind => Kind_Object, + Object_Static => Src.Object_Static, + Object_Var => Instantiate_Var (Src.Object_Var), + Object_Driver => Null_Var, + Object_Rti => Src.Object_Rti, + Object_Function => O_Dnode_Null); + when Kind_Subprg => + Dest.Subprg_Frame_Scope := + Instantiate_Var_Scope (Src.Subprg_Frame_Scope); + Dest.all := + (Kind => Kind_Subprg, + Use_Stack2 => Src.Use_Stack2, + Ortho_Func => Src.Ortho_Func, + Res_Interface => Src.Res_Interface, + Res_Record_Var => Instantiate_Var (Src.Res_Record_Var), + Res_Record_Type => Src.Res_Record_Type, + Res_Record_Ptr => Src.Res_Record_Ptr, + Subprg_Frame_Scope => Dest.Subprg_Frame_Scope, + Subprg_Instance => Instantiate_Subprg_Instance + (Src.Subprg_Instance), + Subprg_Resolv => null, + Subprg_Local_Id => Src.Subprg_Local_Id, + Subprg_Exit => Src.Subprg_Exit, + Subprg_Result => Src.Subprg_Result); + when Kind_Interface => + Dest.all := (Kind => Kind_Interface, + Interface_Node => Src.Interface_Node, + Interface_Field => Src.Interface_Field, + Interface_Type => Src.Interface_Type); + when Kind_Index => + Dest.all := (Kind => Kind_Index, + Index_Field => Src.Index_Field); + when Kind_Expr => + Dest.all := (Kind => Kind_Expr, + Expr_Node => Src.Expr_Node); + when others => + raise Internal_Error; + end case; + end Copy_Info; + procedure Instantiate_Iir_Info (N : Iir) is begin -- Nothing to do for null node. @@ -5660,63 +5730,15 @@ package body Translation is if Orig_Info /= null then Info := Add_Info (N, Orig_Info.Kind); + Copy_Info (Info, Orig_Info); + case Info.Kind is - when Kind_Type => - Info.all := (Kind => Kind_Type, - Type_Mode => Orig_Info.Type_Mode, - Type_Incomplete => Orig_Info.Type_Incomplete, - Type_Locally_Constrained => - Orig_Info.Type_Locally_Constrained, - C => null, - Ortho_Type => Orig_Info.Ortho_Type, - Ortho_Ptr_Type => Orig_Info.Ortho_Ptr_Type, - Type_Transient_Chain => Null_Iir, - T => Orig_Info.T, - Type_Rti => Orig_Info.Type_Rti); - pragma Assert (Orig_Info.C = null); - pragma Assert (Orig_Info.Type_Transient_Chain = Null_Iir); - when Kind_Object => - pragma Assert (Orig_Info.Object_Driver = Null_Var); - pragma Assert (Orig_Info.Object_Function = O_Dnode_Null); - Info.all := - (Kind => Kind_Object, - Object_Static => Orig_Info.Object_Static, - Object_Var => Instantiate_Var (Orig_Info.Object_Var), - Object_Driver => Null_Var, - Object_Rti => Orig_Info.Object_Rti, - Object_Function => O_Dnode_Null); when Kind_Subprg => - Info.Subprg_Frame_Scope := - Instantiate_Var_Scope (Orig_Info.Subprg_Frame_Scope); Push_Instantiate_Var_Scope (Info.Subprg_Frame_Scope'Access, Orig_Info.Subprg_Frame_Scope'Access); - Info.all := - (Kind => Kind_Subprg, - Use_Stack2 => Orig_Info.Use_Stack2, - Ortho_Func => Orig_Info.Ortho_Func, - Res_Interface => Orig_Info.Res_Interface, - Res_Record_Var => - Instantiate_Var (Orig_Info.Res_Record_Var), - Res_Record_Type => Orig_Info.Res_Record_Type, - Res_Record_Ptr => Orig_Info.Res_Record_Ptr, - Subprg_Frame_Scope => Info.Subprg_Frame_Scope, - Subprg_Instance => Instantiate_Subprg_Instance - (Orig_Info.Subprg_Instance), - Subprg_Resolv => null, - Subprg_Local_Id => Orig_Info.Subprg_Local_Id, - Subprg_Exit => Orig_Info.Subprg_Exit, - Subprg_Result => Orig_Info.Subprg_Result); - when Kind_Interface => - Info.all := (Kind => Kind_Interface, - Interface_Node => Orig_Info.Interface_Node, - Interface_Field => Orig_Info.Interface_Field, - Interface_Type => Orig_Info.Interface_Type); - when Kind_Index => - Info.all := (Kind => Kind_Index, - Index_Field => Orig_Info.Index_Field); when others => - raise Internal_Error; + null; end case; end if; @@ -5744,7 +5766,8 @@ package body Translation is case Get_Field_Attribute (F) is when Attr_None => Instantiate_Iir_List_Info (Get_Iir_List (N, F)); - when Attr_Ref => + when Attr_Ref + | Attr_Of_Ref => null; when others => raise Internal_Error; @@ -5797,29 +5820,71 @@ package body Translation is end; end Instantiate_Iir_Info; - procedure Translate_Package_Instantiation_Declaration (Inst : Iir) + procedure Instantiate_Iir_Generic_Chain_Info (Chain : Iir) + is + Inter : Iir; + Orig : Iir; + Orig_Info : Ortho_Info_Acc; + Info : Ortho_Info_Acc; + begin + Inter := Chain; + while Inter /= Null_Iir loop + case Get_Kind (Inter) is + when Iir_Kind_Interface_Constant_Declaration => + Orig := Sem_Inst.Get_Origin (Inter); + Orig_Info := Get_Info (Orig); + + Info := Add_Info (Inter, Orig_Info.Kind); + Copy_Info (Info, Orig_Info); + + when Iir_Kind_Interface_Package_Declaration => + null; + + when others => + raise Internal_Error; + end case; + + Inter := Get_Chain (Inter); + end loop; + end Instantiate_Iir_Generic_Chain_Info; + + -- Add info for an interface_package_declaration or a + -- package_instantiation_declaration + procedure Instantiate_Info_Package (Inst : Iir) is Spec : constant Iir := - Get_Named_Entity (Get_Uninstantiated_Name (Inst)); + Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst)); Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec); Info : Ortho_Info_Acc; - Interface_List : O_Inter_List; - Constr : O_Assoc_List; begin Info := Add_Info (Inst, Kind_Package_Instance); + -- Create the info instances. Push_Instantiate_Var_Scope (Info.Package_Instance_Spec_Scope'Access, Pkg_Info.Package_Spec_Scope'Access); Push_Instantiate_Var_Scope (Info.Package_Instance_Body_Scope'Access, Pkg_Info.Package_Body_Scope'Access); - Instantiate_Iir_Chain_Info (Get_Generic_Chain (Inst)); + Instantiate_Iir_Generic_Chain_Info (Get_Generic_Chain (Inst)); Instantiate_Iir_Chain_Info (Get_Declaration_Chain (Inst)); Pop_Instantiate_Var_Scope (Info.Package_Instance_Body_Scope'Access); Pop_Instantiate_Var_Scope (Info.Package_Instance_Spec_Scope'Access); + end Instantiate_Info_Package; + + procedure Translate_Package_Instantiation_Declaration (Inst : Iir) + is + Spec : constant Iir := + Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst)); + Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec); + Info : Ortho_Info_Acc; + Interface_List : O_Inter_List; + Constr : O_Assoc_List; + begin + Instantiate_Info_Package (Inst); + Info := Get_Info (Inst); -- FIXME: if the instantiation occurs within a package declaration, -- the variable must be declared extern (and public in the body). @@ -5854,7 +5919,14 @@ package body Translation is Elab_Dependence (Get_Design_Unit (Inst)); + Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope, + Get_Var_Label (Info.Package_Instance_Var)); + Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope, + Pkg_Info.Package_Spec_Field, + Pkg_Info.Package_Body_Scope'Access); Chap5.Elab_Generic_Map_Aspect (Inst); + Clear_Scope (Pkg_Info.Package_Spec_Scope); + Clear_Scope (Pkg_Info.Package_Body_Scope); -- Call the elaborator of the generic. The generic must be -- temporary associated with the instance variable. @@ -9503,7 +9575,7 @@ package body Translation is case Get_Kind (El) is when Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Interface_Declaration => + | Iir_Kind_Interface_Constant_Declaration => Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type); when Iir_Kind_Constant_Declaration => @@ -9569,7 +9641,7 @@ package body Translation is case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => Rtis.Generate_Signal_Rti (Decl); when Iir_Kind_Guard_Signal_Declaration => -- No name created for guard signal. @@ -9617,6 +9689,27 @@ package body Translation is Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type); end Create_File_Object; + procedure Create_Package_Interface (Inter : Iir) + is + Info : Ortho_Info_Acc; + Pkg : constant Iir := Get_Named_Entity + (Get_Uninstantiated_Package_Name (Inter)); + Pkg_Info : constant Ortho_Info_Acc := Get_Info (Pkg); + begin + Chap2.Instantiate_Info_Package (Inter); + Info := Get_Info (Inter); + Info.Package_Instance_Var := + Create_Var (Create_Var_Identifier (Inter), + Pkg_Info.Package_Body_Ptr_Type); + Set_Scope_Via_Var_Ptr + (Info.Package_Instance_Body_Scope, + Info.Package_Instance_Var); + Set_Scope_Via_Field + (Info.Package_Instance_Spec_Scope, + Pkg_Info.Package_Spec_Field, + Info.Package_Instance_Body_Scope'Access); + end Create_Package_Interface; + procedure Allocate_Complex_Object (Obj_Type : Iir; Alloc_Kind : Allocation_Kind; Var : in out Mnode) @@ -10794,7 +10887,7 @@ package body Translation is Info := Add_Info (Decl, Kind_Alias); case Get_Kind (Get_Object_Prefix (Decl)) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => Info.Alias_Kind := Mode_Signal; when others => @@ -10915,7 +11008,14 @@ package body Translation is begin Decl := Get_Generic_Chain (Parent); while Decl /= Null_Iir loop - Create_Object (Decl); + case Get_Kind (Decl) is + when Iir_Kinds_Interface_Object_Declaration => + Create_Object (Decl); + when Iir_Kind_Interface_Package_Declaration => + Create_Package_Interface (Decl); + when others => + Error_Kind ("translate_generic_chain", Decl); + end case; Decl := Get_Chain (Decl); end loop; end Translate_Generic_Chain; @@ -10978,7 +11078,7 @@ package body Translation is --when Iir_Kind_Implicit_Function_Declaration => --when Iir_Kind_Signal_Declaration - -- | Iir_Kind_Signal_Interface_Declaration => + -- | Iir_Kind_Interface_Signal_Declaration => -- Chap4.Create_Object (Decl); when Iir_Kind_Variable_Declaration @@ -12622,7 +12722,6 @@ package body Translation is is Assoc : Iir; Formal : Iir; - Targ : Mnode; begin -- Elab generics, and associate. Assoc := Get_Generic_Map_Aspect_Chain (Mapping); @@ -12634,35 +12733,37 @@ package body Translation is end if; case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => - if Get_Whole_Association_Flag (Assoc) then - Chap4.Elab_Object_Storage (Formal); - Targ := Chap6.Translate_Name (Formal); - Chap4.Elab_Object_Init (Targ, Formal, Get_Actual (Assoc)); - else - Targ := Chap6.Translate_Name (Formal); - Chap7.Translate_Assign - (Targ, Get_Actual (Assoc), Get_Type (Formal)); - end if; + declare + Targ : Mnode; + begin + if Get_Whole_Association_Flag (Assoc) then + Chap4.Elab_Object_Storage (Formal); + Targ := Chap6.Translate_Name (Formal); + Chap4.Elab_Object_Init + (Targ, Formal, Get_Actual (Assoc)); + else + Targ := Chap6.Translate_Name (Formal); + Chap7.Translate_Assign + (Targ, Get_Actual (Assoc), Get_Type (Formal)); + end if; + end; when Iir_Kind_Association_Element_Open => Chap4.Elab_Object_Value (Formal, Get_Default_Value (Formal)); when Iir_Kind_Association_Element_By_Individual => -- Create the object. declare + Formal_Type : constant Iir := Get_Type (Formal); + Obj_Info : constant Object_Info_Acc := Get_Info (Formal); + Obj_Type : constant Iir := Get_Actual_Type (Assoc); Formal_Node : Mnode; - Formal_Type : Iir; - Obj_Info : Object_Info_Acc; - Obj_Type : Iir; Type_Info : Type_Info_Acc; Bounds : Mnode; begin - Formal_Type := Get_Type (Formal); Chap3.Elab_Object_Subtype (Formal_Type); Type_Info := Get_Info (Formal_Type); - Obj_Info := Get_Info (Formal); Formal_Node := Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value); Stabilize (Formal_Node); - Obj_Type := Get_Actual_Type (Assoc); if Obj_Type = Null_Iir then Chap4.Allocate_Complex_Object (Formal_Type, Alloc_System, Formal_Node); @@ -12673,8 +12774,30 @@ package body Translation is (Formal_Node, Alloc_System, Formal_Type, Bounds); end if; end; + when Iir_Kind_Association_Element_Package => + pragma Assert (Get_Kind (Formal) = + Iir_Kind_Interface_Package_Declaration); + declare + Uninst_Pkg : constant Iir := Get_Named_Entity + (Get_Uninstantiated_Package_Name (Formal)); + Uninst_Info : constant Ortho_Info_Acc := + Get_Info (Uninst_Pkg); + Formal_Info : constant Ortho_Info_Acc := + Get_Info (Formal); + Actual : constant Iir := Get_Named_Entity + (Get_Actual (Assoc)); + Actual_Info : constant Ortho_Info_Acc := + Get_Info (Actual); + begin + New_Assign_Stmt + (Get_Var (Formal_Info.Package_Instance_Var), + New_Address + (Get_Instance_Ref + (Actual_Info.Package_Instance_Body_Scope), + Uninst_Info.Package_Body_Ptr_Type)); + end; when others => - Error_Kind ("elab_map_aspect(1)", Assoc); + Error_Kind ("elab_generic_map_aspect(1)", Assoc); end case; Close_Temp; Assoc := Get_Chain (Assoc); @@ -13651,11 +13774,11 @@ package body Translation is -- Prefix_Name : Mnode; -- begin -- case Get_Kind (Name) is --- when Iir_Kind_Constant_Interface_Declaration => +-- when Iir_Kind_Interface_Constant_Declaration => -- return Translate_Formal_Interface_Name -- (Scope_Type, Scope_Param, Name, Mode_Value); --- when Iir_Kind_Signal_Interface_Declaration => +-- when Iir_Kind_Interface_Signal_Declaration => -- return Translate_Formal_Interface_Name -- (Scope_Type, Scope_Param, Name, Mode_Signal); @@ -13739,16 +13862,16 @@ package body Translation is | Iir_Kind_Guard_Signal_Declaration => return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Signal); - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => return Translate_Interface_Name (Name, Name_Info, Mode_Value); - when Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_File_Declaration => return Translate_Interface_Name (Name, Name_Info, Mode_Value); - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => return Translate_Interface_Name (Name, Name_Info, Mode_Value); - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => return Translate_Interface_Name (Name, Name_Info, Mode_Signal); when Iir_Kind_Indexed_Name => @@ -13825,7 +13948,7 @@ package body Translation is when Iir_Kind_Object_Alias_Declaration => Translate_Direct_Driver (Get_Name (Name), Sig, Drv); when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => Sig := Get_Var (Name_Info.Object_Var, Type_Info, Mode_Signal); Drv := Get_Var (Name_Info.Object_Driver, Type_Info, Mode_Value); when Iir_Kind_Slice_Name => @@ -14612,12 +14735,12 @@ package body Translation is end case; case Get_Kind (Formal_Base) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => return Chap3.Maybe_Insert_Scalar_Check (Translate_Expression (Actual, Get_Type (Formal)), Actual, Get_Type (Formal)); - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => return Translate_Implicit_Conv (M2E (Chap6.Translate_Name (Actual)), Get_Type (Actual), @@ -17422,10 +17545,10 @@ package body Translation is | Iir_Kind_Signal_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Selected_Element @@ -21316,7 +21439,7 @@ package body Translation is Base_Formal := Get_Association_Interface (El); Formal_Type := Get_Type (Formal); Formal_Info := Get_Info (Base_Formal); - if Get_Kind (Base_Formal) = Iir_Kind_Signal_Interface_Declaration + if Get_Kind (Base_Formal) = Iir_Kind_Interface_Signal_Declaration then Formal_Object_Kind := Mode_Signal; else @@ -21387,13 +21510,13 @@ package body Translation is elsif Ftype_Info.Type_Mode not in Type_Mode_By_Value then -- Passed by reference. case Get_Kind (Base_Formal) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => -- No conversion here. E_Params (Pos) := Chap7.Translate_Expression (Act, Formal_Type); - when Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration => Param := Chap6.Translate_Name (Act); -- Atype may not have been set (eg: slice). if Base_Formal /= Formal then @@ -21420,7 +21543,7 @@ package body Translation is -- By value association. Act := Get_Actual (El); if Get_Kind (Base_Formal) - = Iir_Kind_Constant_Interface_Declaration + = Iir_Kind_Interface_Constant_Declaration then Val := Chap7.Translate_Expression (Act, Formal_Type); else @@ -21505,7 +21628,7 @@ package body Translation is Error_Kind ("translate_procedure_call(2)", El); end case; case Get_Kind (Formal) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Param := Chap6.Translate_Name (Act); -- This is a scalar. Val := M2E (Param); @@ -21546,7 +21669,7 @@ package body Translation is Formal_Type := Get_Type (Formal); Ftype_Info := Get_Info (Formal_Type); Formal_Info := Get_Info (Base_Formal); - if Get_Kind (Base_Formal) = Iir_Kind_Variable_Interface_Declaration + if Get_Kind (Base_Formal) = Iir_Kind_Interface_Variable_Declaration and then Get_Mode (Base_Formal) in Iir_Out_Modes and then Params (Pos) /= Mnode_Null then @@ -23454,7 +23577,7 @@ package body Translation is | Iir_Kind_Transaction_Attribute => El := Get_Prefix (El); when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => exit; when Iir_Kinds_Denoting_Name => @@ -24654,6 +24777,16 @@ package body Translation is Field => Scope_Field, Up_Link => Scope_Parent); end Set_Scope_Via_Field_Ptr; + procedure Set_Scope_Via_Var_Ptr + (Scope : in out Var_Scope_Type; Var : Var_Type) is + begin + pragma Assert (Scope.Kind = Var_Scope_None); + pragma Assert (Var.Kind = Var_Scope); + Scope := (Scope_Type => Scope.Scope_Type, + Kind => Var_Scope_Field_Ptr, + Field => Var.I_Field, Up_Link => Var.I_Scope); + end Set_Scope_Via_Var_Ptr; + procedure Set_Scope_Via_Param_Ptr (Scope : in out Var_Scope_Type; Scope_Param : O_Dnode) is begin @@ -27924,14 +28057,14 @@ package body Translation is when Iir_Kind_Signal_Declaration => Comm := Ghdl_Rtik_Signal; Var := Info.Object_Var; - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Comm := Ghdl_Rtik_Port; Var := Info.Object_Var; Mode := Iir_Mode'Pos (Get_Mode (Decl)); when Iir_Kind_Constant_Declaration => Comm := Ghdl_Rtik_Constant; Var := Info.Object_Var; - when Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration => Comm := Ghdl_Rtik_Generic; Var := Info.Object_Var; when Iir_Kind_Variable_Declaration => @@ -27967,7 +28100,7 @@ package body Translation is end case; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => Mode := Mode + 16 * Iir_Signal_Kind'Pos (Get_Signal_Kind (Decl)); when others => @@ -27975,7 +28108,7 @@ package body Translation is end case; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Transaction_Attribute | Iir_Kind_Stable_Attribute @@ -28072,9 +28205,9 @@ package body Translation is -- Eg: array subtypes. null; when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Transaction_Attribute @@ -28228,8 +28361,8 @@ package body Translation is end; end if; when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Transaction_Attribute @@ -31077,10 +31210,9 @@ package body Translation is for I in Design_Units.First .. Design_Units.Last loop Unit := Design_Units.Table (I); Sem.Sem_Analysis_Checks_List (Unit, False); - if Get_Analysis_Checks_List (Unit) /= Null_Iir_List then - -- There cannot be remaining checks to do. - raise Internal_Error; - end if; + -- There cannot be remaining checks to do. + pragma Assert + (Get_Analysis_Checks_List (Unit) = Null_Iir_List); end loop; end if; diff --git a/xtools/pnodes.py b/xtools/pnodes.py index c6f67f6..364f125 100755 --- a/xtools/pnodes.py +++ b/xtools/pnodes.py @@ -104,41 +104,48 @@ def read_fields(file): pat_field_desc = re.compile(' -- (\w+) : (\w+).*\n') format_name = '' common_desc = {} - try: - while True: - # 1) Search for description - while True: - # The common one - if l == ' -- Common fields are:\n': - format_name = 'Common' - break - # One for a format - m = pat_fields.match(l) - if m != None: - format_name = m.group(1) - if not format_name in fields: - raise ParseError( - lr, 'Format ' + format_name + ' is unknown'); - break - l = lr.get() - # 2) Read field description + # Read until common fields. + while l != ' -- Common fields are:\n': + l = lr.get() + format_name = 'Common' + nbr_formats = 0 + + while True: + # 1) Read field description + l = lr.get() + desc = common_desc.copy() + while True: + m = pat_field_desc.match(l) + if m == None: + break + desc[m.group(1)] = m.group(2) l = lr.get() - desc = common_desc - while True: - m = pat_field_desc.match(l) - if m == None: - break - desc[m.group(1)] = m.group(2) - l = lr.get() + # print 'For: ' + format_name + ': ' + m.group(1) - # 3) Disp - if format_name == 'Common': - common_desc = desc + # 2) Disp + if format_name == 'Common': + common_desc = desc + else: + fields[format_name] = desc + + # 3) Read next format + if l == '\n': + if nbr_formats == len(fields): + break else: - fields[format_name] = desc - except EndOfFile: - pass + l = lr.get() + + # One for a format + m = pat_fields.match(l) + if m != None: + format_name = m.group(1) + if not format_name in fields: + raise ParseError( + lr, 'Format ' + format_name + ' is unknown') + nbr_formats = nbr_formats + 1 + else: + raise ParseError(lr, 'unhandled format line') return (formats, fields) @@ -321,7 +328,8 @@ def read_nodes_fields(lr, names, fields, nodes, funcs_dict): raise ParseError(lr, 'field mismatch') for c in only_nodes: if field not in c.fields: - raise ParseError(lr, 'field does not exist in node') + raise ParseError(lr, 'field ' + field + \ + ' does not exist in node') if not alias: if c.fields[field]: raise ParseError(lr, 'field already used') @@ -335,7 +343,7 @@ def read_nodes_fields(lr, names, fields, nodes, funcs_dict): l = lr.get() # Read description for all nodes -def read_nodes(filename, kinds_ranges, fields, funcs): +def read_nodes(filename, kinds, kinds_ranges, fields, funcs): lr = linereader(filename) funcs_dict = {x.name:x for x in funcs} nodes = {} @@ -362,6 +370,8 @@ def read_nodes(filename, kinds_ranges, fields, funcs): # Declaration of the first node while True: name=m.group(1) + if not name in kinds: + raise ParseError(lr, 'unknown node') fmt=m.group(2) names.append((name,fmt)) # There might be several nodes described at once. @@ -487,7 +497,7 @@ args = parser.parse_args() try: (formats, fields) = read_fields(field_file) (kinds, kinds_ranges, funcs) = read_kinds(spec_file) - nodes = read_nodes(spec_file,kinds_ranges,fields,funcs) + nodes = read_nodes(spec_file,kinds,kinds_ranges,fields,funcs) except ParseError as e: print >> sys.stderr, e |