From 46100a0f24670f4d01ecc114da2ac5fedbab13af Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 5 May 2019 08:22:05 +0200 Subject: vhdl: move elocations* packages to vhdl children. --- src/vhdl/Makefile | 15 +- src/vhdl/elocations.adb | 710 ----------------------------------- src/vhdl/elocations.adb.in | 188 ---------- src/vhdl/elocations.ads | 699 ---------------------------------- src/vhdl/elocations_meta.adb | 405 -------------------- src/vhdl/elocations_meta.adb.in | 43 --- src/vhdl/elocations_meta.ads | 69 ---- src/vhdl/elocations_meta.ads.in | 36 -- src/vhdl/vhdl-elocations.adb | 710 +++++++++++++++++++++++++++++++++++ src/vhdl/vhdl-elocations.adb.in | 188 ++++++++++ src/vhdl/vhdl-elocations.ads | 699 ++++++++++++++++++++++++++++++++++ src/vhdl/vhdl-elocations_meta.adb | 405 ++++++++++++++++++++ src/vhdl/vhdl-elocations_meta.adb.in | 43 +++ src/vhdl/vhdl-elocations_meta.ads | 69 ++++ src/vhdl/vhdl-elocations_meta.ads.in | 36 ++ src/vhdl/vhdl-parse.adb | 2 +- 16 files changed, 2159 insertions(+), 2158 deletions(-) delete mode 100644 src/vhdl/elocations.adb delete mode 100644 src/vhdl/elocations.adb.in delete mode 100644 src/vhdl/elocations.ads delete mode 100644 src/vhdl/elocations_meta.adb delete mode 100644 src/vhdl/elocations_meta.adb.in delete mode 100644 src/vhdl/elocations_meta.ads delete mode 100644 src/vhdl/elocations_meta.ads.in create mode 100644 src/vhdl/vhdl-elocations.adb create mode 100644 src/vhdl/vhdl-elocations.adb.in create mode 100644 src/vhdl/vhdl-elocations.ads create mode 100644 src/vhdl/vhdl-elocations_meta.adb create mode 100644 src/vhdl/vhdl-elocations_meta.adb.in create mode 100644 src/vhdl/vhdl-elocations_meta.ads create mode 100644 src/vhdl/vhdl-elocations_meta.ads.in (limited to 'src/vhdl') diff --git a/src/vhdl/Makefile b/src/vhdl/Makefile index 2ff18046f..a18d334c6 100644 --- a/src/vhdl/Makefile +++ b/src/vhdl/Makefile @@ -26,13 +26,14 @@ PNODESPY=python/pnodespy.py DEPS=iirs.ads nodes.ads $(PNODES) GEN_FILES=iirs.adb nodes_meta.ads nodes_meta.adb \ - elocations.adb elocations_meta.ads elocations_meta.adb \ + vhdl-elocations.adb vhdl-elocations_meta.ads vhdl-elocations_meta.adb \ python/libghdl/iirs.py python/libghdl/nodes_meta.py \ python/libghdl/std_names.py python/libghdl/tokens.py \ python/libghdl/elocations.py python/libghdl/errorout.py -ELOCATIONS_FLAGS=--node-file=elocations.ads --field-file=elocations.adb.in \ - --template-file=elocations.adb.in --meta-basename=elocations_meta +ELOCATIONS_FLAGS=--node-file=vhdl-elocations.ads \ + --field-file=vhdl-elocations.adb.in \ + --template-file=vhdl-elocations.adb.in --meta-basename=vhdl-elocations_meta all: $(GEN_FILES) @@ -51,17 +52,17 @@ nodes_meta.adb: nodes_meta.adb.in $(DEPS) $(PNODES) meta_body > $@ chmod -w $@ -elocations.adb: elocations.adb.in elocations.ads $(DEPS) +vhdl-elocations.adb: vhdl-elocations.adb.in vhdl-elocations.ads $(DEPS) $(RM) $@ $(PNODES) $(ELOCATIONS_FLAGS) body > $@ chmod -w $@ -elocations_meta.ads: elocations_meta.ads.in elocations.ads $(DEPS) +vhdl-elocations_meta.ads: vhdl-elocations_meta.ads.in vhdl-elocations.ads $(DEPS) $(RM) $@ $(PNODES) $(ELOCATIONS_FLAGS) meta_specs > $@ chmod -w $@ -elocations_meta.adb: elocations_meta.adb.in elocations.ads $(DEPS) +vhdl-elocations_meta.adb: vhdl-elocations_meta.adb.in vhdl-elocations.ads $(DEPS) $(RM) $@ $(PNODES) $(ELOCATIONS_FLAGS) meta_body > $@ chmod -w $@ @@ -86,7 +87,7 @@ python/libghdl/tokens.py: $(PNODESPY) vhdl-tokens.ads $(PNODESPY) libghdl-tokens > $@ chmod -w $@ -python/libghdl/elocations.py: $(PNODESPY) elocations.ads +python/libghdl/elocations.py: $(PNODESPY) vhdl-elocations.ads $(RM) $@ $(PNODESPY) $(ELOCATIONS_FLAGS) libghdl-elocs > $@ chmod -w $@ diff --git a/src/vhdl/elocations.adb b/src/vhdl/elocations.adb deleted file mode 100644 index 9ba4f8325..000000000 --- a/src/vhdl/elocations.adb +++ /dev/null @@ -1,710 +0,0 @@ --- Extended locations for iir nodes --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Tables; -with Nodes; -with Elocations_Meta; use Elocations_Meta; - -package body Elocations is - - -- Format of a node. - type Format_Type is - ( - Format_None, - Format_L1, - Format_L2, - Format_L3, - Format_L4, - Format_L5, - Format_L6 - ); - - -- Common fields are: - - -- Fields of Format_None: - - -- Fields of Format_L1: - -- Field1 : Location_Type - - -- Fields of Format_L2: - -- Field1 : Location_Type - -- Field2 : Location_Type - - -- Fields of Format_L3: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - - -- Fields of Format_L4: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - - -- Fields of Format_L5: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - -- Field5 : Location_Type - - -- Fields of Format_L6: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - -- Field5 : Location_Type - -- Field6 : Location_Type - - function Get_Format (Kind : Iir_Kind) return Format_Type; - - type Location_Index_Type is new Types.Nat32; - No_Location_Index : constant Location_Index_Type := 0; - - package Elocations_Index_Table is new Tables - (Table_Component_Type => Location_Index_Type, - Table_Index_Type => Iir, - Table_Low_Bound => 2, - Table_Initial => 1024); - - package Elocations_Table is new Tables - (Table_Component_Type => Location_Type, - Table_Index_Type => Location_Index_Type, - Table_Low_Bound => 2, - Table_Initial => 1024); - - procedure Create_Elocations (N : Iir) - is - use Nodes; - Format : constant Format_Type := Get_Format (Get_Kind (N)); - El : constant Iir := Elocations_Index_Table.Last; - Len : Location_Index_Type; - Idx : Location_Index_Type; - begin - pragma Assert (Format /= Format_None); - - if El < N then - Elocations_Index_Table.Set_Last (N); - Elocations_Index_Table.Table (El + 1 .. N) := - (others => No_Location_Index); - end if; - - -- Must be called once. - pragma Assert (Elocations_Index_Table.Table (N) = No_Location_Index); - - case Format is - when Format_None => - raise Program_Error; - when Format_L1 => - Len := 1; - when Format_L2 => - Len := 2; - when Format_L3 => - Len := 3; - when Format_L4 => - Len := 4; - when Format_L5 => - Len := 5; - when Format_L6 => - Len := 6; - end case; - - Idx := Elocations_Table.Last + 1; - Elocations_Index_Table.Table (N) := Idx; - Elocations_Table.Set_Last (Idx + Len - 1); - Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location); - end Create_Elocations; - - procedure Delete_Elocations (N : Iir) is - begin - -- Clear the corresponding index. - Elocations_Index_Table.Table (N) := No_Location_Index; - - -- FIXME: keep free slots in chained list ? - end Delete_Elocations; - - generic - Off : Location_Index_Type; - function Get_FieldX (N : Iir) return Location_Type; - - generic - Off : Location_Index_Type; - procedure Set_FieldX (N : Iir; Loc : Location_Type); - - function Get_FieldX (N : Iir) return Location_Type - is - use Nodes; - Idx : Location_Index_Type; - begin - pragma Assert (N <= Elocations_Index_Table.Last); - Idx := Elocations_Index_Table.Table (N); - return Elocations_Table.Table (Idx + Off - 1); - end Get_FieldX; - - procedure Set_FieldX (N : Iir; Loc : Location_Type) - is - use Nodes; - Idx : Location_Index_Type; - begin - pragma Assert (N <= Elocations_Index_Table.Last); - Idx := Elocations_Index_Table.Table (N); - Elocations_Table.Table (Idx + Off - 1) := Loc; - end Set_FieldX; - - function Get_Field1 is new Get_FieldX (1); - procedure Set_Field1 is new Set_FieldX (1); - - function Get_Field2 is new Get_FieldX (2); - procedure Set_Field2 is new Set_FieldX (2); - - function Get_Field3 is new Get_FieldX (3); - procedure Set_Field3 is new Set_FieldX (3); - - function Get_Field4 is new Get_FieldX (4); - procedure Set_Field4 is new Set_FieldX (4); - - function Get_Field5 is new Get_FieldX (5); - procedure Set_Field5 is new Set_FieldX (5); - - function Get_Field6 is new Get_FieldX (6); - procedure Set_Field6 is new Set_FieldX (6); - - -- Subprograms - function Get_Format (Kind : Iir_Kind) return Format_Type is - begin - case Kind is - when Iir_Kind_Unused - | Iir_Kind_Error - | Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Use_Clause - | Iir_Kind_Context_Reference - | Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal8 - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Unaffected_Waveform - | Iir_Kind_Waveform_Element - | Iir_Kind_Conditional_Waveform - | Iir_Kind_Conditional_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration - | Iir_Kind_Entity_Aspect_Open - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Binding_Indication - | Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Value - | Iir_Kind_Signature - | Iir_Kind_Aggregate_Info - | Iir_Kind_Procedure_Call - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Array_Element_Resolution - | Iir_Kind_Record_Resolution - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_Interface_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Range_Expression - | Iir_Kind_Wildcard_Type_Definition - | Iir_Kind_Subtype_Definition - | Iir_Kind_Scalar_Nature_Definition - | Iir_Kind_Overload_List - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Endpoint_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Interface_Function_Declaration - | Iir_Kind_Interface_Procedure_Declaration - | Iir_Kind_Signal_Attribute_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Implicit_Condition_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Psl_Expression - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Case_Generate_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Simple_Signal_Assignment_Statement - | Iir_Kind_Conditional_Signal_Assignment_Statement - | Iir_Kind_Selected_Waveform_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Conditional_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Reference_Name - | Iir_Kind_External_Constant_Name - | Iir_Kind_External_Signal_Name - | Iir_Kind_External_Variable_Name - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Package_Pathname - | Iir_Kind_Absolute_Pathname - | Iir_Kind_Relative_Pathname - | Iir_Kind_Pathname_Element - | Iir_Kind_Base_Attribute - | Iir_Kind_Subtype_Attribute - | Iir_Kind_Element_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Behavior_Attribute - | Iir_Kind_Structure_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return Format_None; - when Iir_Kind_Library_Clause - | Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package - | Iir_Kind_Association_Element_Type - | Iir_Kind_Association_Element_Subprogram - | Iir_Kind_Attribute_Specification - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Type_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Concurrent_Simple_Signal_Assignment - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment => - return Format_L1; - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Context_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Case_Statement => - return Format_L2; - when Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Generate_Statement_Body - | Iir_Kind_If_Generate_Else_Clause - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return Format_L3; - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement => - return Format_L4; - when Iir_Kind_Package_Header => - return Format_L5; - when Iir_Kind_Block_Header - | Iir_Kind_Entity_Declaration - | Iir_Kind_Component_Declaration => - return Format_L6; - end case; - end Get_Format; - - function Get_Start_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Start_Location (Get_Kind (N)), - "no field Start_Location"); - return Get_Field1 (N); - end Get_Start_Location; - - procedure Set_Start_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Start_Location (Get_Kind (N)), - "no field Start_Location"); - Set_Field1 (N, Loc); - end Set_Start_Location; - - function Get_Right_Paren_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Right_Paren_Location (Get_Kind (N)), - "no field Right_Paren_Location"); - return Get_Field1 (N); - end Get_Right_Paren_Location; - - procedure Set_Right_Paren_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Right_Paren_Location (Get_Kind (N)), - "no field Right_Paren_Location"); - Set_Field1 (N, Loc); - end Set_Right_Paren_Location; - - function Get_End_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (N)), - "no field End_Location"); - return Get_Field2 (N); - end Get_End_Location; - - procedure Set_End_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (N)), - "no field End_Location"); - Set_Field2 (N, Loc); - end Set_End_Location; - - function Get_Is_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Is_Location (Get_Kind (N)), - "no field Is_Location"); - return Get_Field4 (N); - end Get_Is_Location; - - procedure Set_Is_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Is_Location (Get_Kind (N)), - "no field Is_Location"); - Set_Field4 (N, Loc); - end Set_Is_Location; - - function Get_Begin_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Begin_Location (Get_Kind (N)), - "no field Begin_Location"); - return Get_Field3 (N); - end Get_Begin_Location; - - procedure Set_Begin_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Begin_Location (Get_Kind (N)), - "no field Begin_Location"); - Set_Field3 (N, Loc); - end Set_Begin_Location; - - function Get_Then_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Then_Location (Get_Kind (N)), - "no field Then_Location"); - return Get_Field3 (N); - end Get_Then_Location; - - procedure Set_Then_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Then_Location (Get_Kind (N)), - "no field Then_Location"); - Set_Field3 (N, Loc); - end Set_Then_Location; - - function Get_Loop_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Loop_Location (Get_Kind (N)), - "no field Loop_Location"); - return Get_Field3 (N); - end Get_Loop_Location; - - procedure Set_Loop_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Loop_Location (Get_Kind (N)), - "no field Loop_Location"); - Set_Field3 (N, Loc); - end Set_Loop_Location; - - function Get_Generate_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generate_Location (Get_Kind (N)), - "no field Generate_Location"); - return Get_Field3 (N); - end Get_Generate_Location; - - procedure Set_Generate_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generate_Location (Get_Kind (N)), - "no field Generate_Location"); - Set_Field3 (N, Loc); - end Set_Generate_Location; - - function Get_Generic_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generic_Location (Get_Kind (N)), - "no field Generic_Location"); - return Get_Field5 (N); - end Get_Generic_Location; - - procedure Set_Generic_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generic_Location (Get_Kind (N)), - "no field Generic_Location"); - Set_Field5 (N, Loc); - end Set_Generic_Location; - - function Get_Port_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Port_Location (Get_Kind (N)), - "no field Port_Location"); - return Get_Field6 (N); - end Get_Port_Location; - - procedure Set_Port_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Port_Location (Get_Kind (N)), - "no field Port_Location"); - Set_Field6 (N, Loc); - end Set_Port_Location; - - function Get_Generic_Map_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generic_Map_Location (Get_Kind (N)), - "no field Generic_Map_Location"); - return Get_Field3 (N); - end Get_Generic_Map_Location; - - procedure Set_Generic_Map_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Generic_Map_Location (Get_Kind (N)), - "no field Generic_Map_Location"); - Set_Field3 (N, Loc); - end Set_Generic_Map_Location; - - function Get_Port_Map_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Port_Map_Location (Get_Kind (N)), - "no field Port_Map_Location"); - return Get_Field2 (N); - end Get_Port_Map_Location; - - procedure Set_Port_Map_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Port_Map_Location (Get_Kind (N)), - "no field Port_Map_Location"); - Set_Field2 (N, Loc); - end Set_Port_Map_Location; - - function Get_Arrow_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Arrow_Location (Get_Kind (N)), - "no field Arrow_Location"); - return Get_Field1 (N); - end Get_Arrow_Location; - - procedure Set_Arrow_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Arrow_Location (Get_Kind (N)), - "no field Arrow_Location"); - Set_Field1 (N, Loc); - end Set_Arrow_Location; - - function Get_Colon_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Colon_Location (Get_Kind (N)), - "no field Colon_Location"); - return Get_Field2 (N); - end Get_Colon_Location; - - procedure Set_Colon_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Colon_Location (Get_Kind (N)), - "no field Colon_Location"); - Set_Field2 (N, Loc); - end Set_Colon_Location; - - function Get_Assign_Location (N : Iir) return Location_Type is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Assign_Location (Get_Kind (N)), - "no field Assign_Location"); - return Get_Field3 (N); - end Get_Assign_Location; - - procedure Set_Assign_Location (N : Iir; Loc : Location_Type) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Assign_Location (Get_Kind (N)), - "no field Assign_Location"); - Set_Field3 (N, Loc); - end Set_Assign_Location; - -end Elocations; diff --git a/src/vhdl/elocations.adb.in b/src/vhdl/elocations.adb.in deleted file mode 100644 index 95a73dd54..000000000 --- a/src/vhdl/elocations.adb.in +++ /dev/null @@ -1,188 +0,0 @@ --- Extended locations for iir nodes --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Tables; -with Nodes; -with Elocations_Meta; use Elocations_Meta; - -package body Elocations is - - -- Format of a node. - type Format_Type is - ( - Format_None, - Format_L1, - Format_L2, - Format_L3, - Format_L4, - Format_L5, - Format_L6 - ); - - -- Common fields are: - - -- Fields of Format_None: - - -- Fields of Format_L1: - -- Field1 : Location_Type - - -- Fields of Format_L2: - -- Field1 : Location_Type - -- Field2 : Location_Type - - -- Fields of Format_L3: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - - -- Fields of Format_L4: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - - -- Fields of Format_L5: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - -- Field5 : Location_Type - - -- Fields of Format_L6: - -- Field1 : Location_Type - -- Field2 : Location_Type - -- Field3 : Location_Type - -- Field4 : Location_Type - -- Field5 : Location_Type - -- Field6 : Location_Type - - function Get_Format (Kind : Iir_Kind) return Format_Type; - - type Location_Index_Type is new Types.Nat32; - No_Location_Index : constant Location_Index_Type := 0; - - package Elocations_Index_Table is new Tables - (Table_Component_Type => Location_Index_Type, - Table_Index_Type => Iir, - Table_Low_Bound => 2, - Table_Initial => 1024); - - package Elocations_Table is new Tables - (Table_Component_Type => Location_Type, - Table_Index_Type => Location_Index_Type, - Table_Low_Bound => 2, - Table_Initial => 1024); - - procedure Create_Elocations (N : Iir) - is - use Nodes; - Format : constant Format_Type := Get_Format (Get_Kind (N)); - El : constant Iir := Elocations_Index_Table.Last; - Len : Location_Index_Type; - Idx : Location_Index_Type; - begin - pragma Assert (Format /= Format_None); - - if El < N then - Elocations_Index_Table.Set_Last (N); - Elocations_Index_Table.Table (El + 1 .. N) := - (others => No_Location_Index); - end if; - - -- Must be called once. - pragma Assert (Elocations_Index_Table.Table (N) = No_Location_Index); - - case Format is - when Format_None => - raise Program_Error; - when Format_L1 => - Len := 1; - when Format_L2 => - Len := 2; - when Format_L3 => - Len := 3; - when Format_L4 => - Len := 4; - when Format_L5 => - Len := 5; - when Format_L6 => - Len := 6; - end case; - - Idx := Elocations_Table.Last + 1; - Elocations_Index_Table.Table (N) := Idx; - Elocations_Table.Set_Last (Idx + Len - 1); - Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location); - end Create_Elocations; - - procedure Delete_Elocations (N : Iir) is - begin - -- Clear the corresponding index. - Elocations_Index_Table.Table (N) := No_Location_Index; - - -- FIXME: keep free slots in chained list ? - end Delete_Elocations; - - generic - Off : Location_Index_Type; - function Get_FieldX (N : Iir) return Location_Type; - - generic - Off : Location_Index_Type; - procedure Set_FieldX (N : Iir; Loc : Location_Type); - - function Get_FieldX (N : Iir) return Location_Type - is - use Nodes; - Idx : Location_Index_Type; - begin - pragma Assert (N <= Elocations_Index_Table.Last); - Idx := Elocations_Index_Table.Table (N); - return Elocations_Table.Table (Idx + Off - 1); - end Get_FieldX; - - procedure Set_FieldX (N : Iir; Loc : Location_Type) - is - use Nodes; - Idx : Location_Index_Type; - begin - pragma Assert (N <= Elocations_Index_Table.Last); - Idx := Elocations_Index_Table.Table (N); - Elocations_Table.Table (Idx + Off - 1) := Loc; - end Set_FieldX; - - function Get_Field1 is new Get_FieldX (1); - procedure Set_Field1 is new Set_FieldX (1); - - function Get_Field2 is new Get_FieldX (2); - procedure Set_Field2 is new Set_FieldX (2); - - function Get_Field3 is new Get_FieldX (3); - procedure Set_Field3 is new Set_FieldX (3); - - function Get_Field4 is new Get_FieldX (4); - procedure Set_Field4 is new Set_FieldX (4); - - function Get_Field5 is new Get_FieldX (5); - procedure Set_Field5 is new Set_FieldX (5); - - function Get_Field6 is new Get_FieldX (6); - procedure Set_Field6 is new Set_FieldX (6); - - -- Subprograms -end Elocations; diff --git a/src/vhdl/elocations.ads b/src/vhdl/elocations.ads deleted file mode 100644 index 82450debd..000000000 --- a/src/vhdl/elocations.ads +++ /dev/null @@ -1,699 +0,0 @@ --- Extended locations for iir nodes --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; - -package Elocations is - - -- Start of Iir_Kind. - - -- Iir_Kind_Design_File (None) - - -- Iir_Kind_Design_Unit (None) - - -- Iir_Kind_Library_Clause (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_String_Literal8 (None) - - -- Iir_Kind_Integer_Literal (None) - - -- Iir_Kind_Floating_Point_Literal (None) - - -- Iir_Kind_Null_Literal (None) - - -- Iir_Kind_Physical_Int_Literal (None) - -- Iir_Kind_Physical_Fp_Literal (None) - - -- Iir_Kind_Simple_Aggregate (None) - - -- Iir_Kind_Overflow_Literal (None) - - -- Iir_Kind_Unaffected_Waveform (None) - - ------------- - -- Tuples -- - ------------- - - -- Iir_Kind_Association_Element_By_Expression (L1) - -- Iir_Kind_Association_Element_Open (L1) - -- Iir_Kind_Association_Element_By_Individual (L1) - -- Iir_Kind_Association_Element_Package (L1) - -- Iir_Kind_Association_Element_Type (L1) - -- Iir_Kind_Association_Element_Subprogram (L1) - -- - -- Get/Set_Arrow_Location (Field1) - - -- Iir_Kind_Waveform_Element (None) - - -- Iir_Kind_Conditional_Waveform (None) - - -- Iir_Kind_Conditional_Expression (None) - - -- Iir_Kind_Choice_By_Others (None) - -- Iir_Kind_Choice_By_None (None) - -- Iir_Kind_Choice_By_Range (None) - -- Iir_Kind_Choice_By_Name (None) - -- Iir_Kind_Choice_By_Expression (None) - - -- Iir_Kind_Entity_Aspect_Entity (None) - - -- Iir_Kind_Entity_Aspect_Open (None) - - -- Iir_Kind_Entity_Aspect_Configuration (None) - - -- Iir_Kind_Block_Configuration (None) - - -- Iir_Kind_Binding_Indication (None) - - -- Iir_Kind_Component_Configuration (None) - -- Iir_Kind_Configuration_Specification (None) - - -- Iir_Kind_Disconnection_Specification (None) - - -- Iir_Kind_Block_Header (L6) - -- - -- Get/Set_Generic_Location (Field5) - -- - -- Get/Set_Port_Location (Field6) - -- - -- Get/Set_Generic_Map_Location (Field3) - -- - -- Get/Set_Port_Map_Location (Field2) - - -- Iir_Kind_Entity_Class (None) - - -- Iir_Kind_Attribute_Specification (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Attribute_Value (None) - - -- Iir_Kind_Psl_Expression (None) - - -- Iir_Kind_Signature (None) - - -- Iir_Kind_Overload_List (None) - - ------------------- - -- Declarations -- - ------------------- - - -- Iir_Kind_Entity_Declaration (L6) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Generic_Location (Field5) - -- - -- Get/Set_Port_Location (Field6) - -- - -- Get/Set_Begin_Location (Field3) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Architecture_Body (L4) - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Begin_Location (Field3) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Configuration_Declaration (L2) - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Package_Header (L5) - -- - -- Get/Set_Generic_Location (Field5) - -- - -- Get/Set_Generic_Map_Location (Field3) - - -- Iir_Kind_Package_Declaration (L2) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Package_Body (L2) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Package_Instantiation_Declaration (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Correspond to the final ';'. - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Generic_Map_Location (Field3) - - -- Iir_Kind_Context_Declaration (L2) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Library_Declaration (None) - - -- Iir_Kind_Component_Declaration (L6) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Generic_Location (Field5) - -- - -- Get/Set_Port_Location (Field6) - - -- Iir_Kind_Object_Alias_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Non_Object_Alias_Declaration (None) - - -- Iir_Kind_Anonymous_Type_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Type_Declaration (L4) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Subtype_Declaration (L4) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Nature_Declaration (None) - - -- Iir_Kind_Subnature_Declaration (None) - - -- Iir_Kind_Interface_Signal_Declaration (L3) - -- Iir_Kind_Interface_Constant_Declaration (L3) - -- Iir_Kind_Interface_Variable_Declaration (L3) - -- Iir_Kind_Interface_File_Declaration (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_Colon_Location (Field2) - -- - -- Get/Set_Assign_Location (Field3) - - -- Iir_Kind_Interface_Type_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Interface_Package_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Function_Declaration (L1) - -- Iir_Kind_Procedure_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Function_Body (L4) - -- Iir_Kind_Procedure_Body (L4) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Begin_Location (Field3) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Interface_Function_Declaration (None) - -- Iir_Kind_Interface_Procedure_Declaration (None) - - -- Iir_Kind_Signal_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Guard_Signal_Declaration (None) - - -- Iir_Kind_Signal_Attribute_Declaration (None) - - -- Iir_Kind_Constant_Declaration (L1) - -- Iir_Kind_Iterator_Declaration (L1) - -- Iir_Kind_Variable_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_File_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Element_Declaration (None) - - -- Iir_Kind_Record_Resolution (None) - - -- Iir_Kind_Record_Element_Constraint (None) - - -- Iir_Kind_Attribute_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Group_Template_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Group_Declaration (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Psl_Endpoint_Declaration (None) - - -- Iir_Kind_Psl_Declaration (None) - - -- Iir_Kind_Terminal_Declaration (None) - - -- Iir_Kind_Free_Quantity_Declaration (None) - - -- Iir_Kind_Across_Quantity_Declaration (None) - -- Iir_Kind_Through_Quantity_Declaration (None) - - -- Iir_Kind_Use_Clause (None) - - -- Iir_Kind_Context_Reference (None) - - ----------------------- - -- type definitions -- - ----------------------- - - -- Iir_Kind_Enumeration_Type_Definition (None) - - -- Iir_Kind_Enumeration_Literal (None) - - -- Iir_Kind_Physical_Type_Definition (None) - - -- Iir_Kind_Unit_Declaration (None) - - -- Iir_Kind_Integer_Type_Definition (None) - -- Iir_Kind_Floating_Type_Definition (None) - - -- Iir_Kind_Array_Type_Definition (None) - - -- Iir_Kind_Record_Type_Definition (L2) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Access_Type_Definition (None) - - -- Iir_Kind_File_Type_Definition (None) - - -- Iir_Kind_Incomplete_Type_Definition (None) - - -- Iir_Kind_Interface_Type_Definition (None) - - -- Iir_Kind_Protected_Type_Declaration (L2) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Protected_Type_Body (L2) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Wildcard_Type_Definition (None) - - -------------------------- - -- subtype definitions -- - -------------------------- - - -- Iir_Kind_Enumeration_Subtype_Definition (None) - -- Iir_Kind_Integer_Subtype_Definition (None) - -- Iir_Kind_Physical_Subtype_Definition (None) - - -- Iir_Kind_Floating_Subtype_Definition (None) - - -- Iir_Kind_Access_Subtype_Definition (None) - - -- Iir_Kind_Array_Element_Resolution (None) - - -- Iir_Kind_Record_Element_Resolution (None) - - -- Iir_Kind_Record_Subtype_Definition (None) - - -- Iir_Kind_Array_Subtype_Definition (None) - - -- Iir_Kind_Range_Expression (None) - - -- Iir_Kind_Subtype_Definition (None) - - ------------------------- - -- Nature definitions -- - ------------------------- - - -- Iir_Kind_Scalar_Nature_Definition (None) - - ---------------------------- - -- concurrent statements -- - ---------------------------- - - -- Iir_Kind_Concurrent_Conditional_Signal_Assignment (L1) - -- Iir_Kind_Concurrent_Selected_Signal_Assignment (L1) - -- Iir_Kind_Concurrent_Simple_Signal_Assignment (L1) - -- - -- Get/Set_Start_Location (Field1) - - -- Iir_Kind_Sensitized_Process_Statement (L4) - -- Iir_Kind_Process_Statement (L4) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Begin_Location (Field3) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Concurrent_Assertion_Statement (None) - - -- Iir_Kind_Psl_Default_Clock (None) - - -- Iir_Kind_Psl_Assert_Statement (None) - -- Iir_Kind_Psl_Cover_Statement (None) - - -- Iir_Kind_Component_Instantiation_Statement (L3) - -- - -- Get/Set_Generic_Map_Location (Field3) - -- - -- Get/Set_Port_Map_Location (Field2) - - -- Iir_Kind_Block_Statement (L4) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Begin_Location (Field3) - -- - -- Get/Set_Is_Location (Field4) - - -- Iir_Kind_Generate_Statement_Body (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Begin_Location (Field3) - - -- Iir_Kind_For_Generate_Statement (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Generate_Location (Field3) - - -- Iir_Kind_If_Generate_Else_Clause (L3) - -- Iir_Kind_If_Generate_Statement (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Generate_Location (Field3) - - -- Iir_Kind_Case_Generate_Statement (None) - - -- Iir_Kind_Simple_Simultaneous_Statement (None) - - ---------------------------- - -- sequential statements -- - ---------------------------- - - -- Iir_Kind_If_Statement (L3) - -- Iir_Kind_Elsif (L3) - -- - -- Location of 'if', 'else' or 'elsif'. - -- Get/Set_Start_Location (Field1) - -- - -- Location of the next 'elsif', 'else' or 'end if'. - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Then_Location (Field3) - - -- Iir_Kind_For_Loop_Statement (L3) - -- Iir_Kind_While_Loop_Statement (L3) - -- - -- Get/Set_Start_Location (Field1) - -- - -- Get/Set_End_Location (Field2) - -- - -- Get/Set_Loop_Location (Field3) - - -- Iir_Kind_Exit_Statement (None) - -- Iir_Kind_Next_Statement (None) - - -- Iir_Kind_Simple_Signal_Assignment_Statement (None) - -- Iir_Kind_Conditional_Signal_Assignment_Statement (None) - -- Iir_Kind_Selected_Waveform_Assignment_Statement (None) - - -- Iir_Kind_Variable_Assignment_Statement (None) - - -- Iir_Kind_Conditional_Variable_Assignment_Statement (None) - - -- Iir_Kind_Assertion_Statement (None) - - -- Iir_Kind_Report_Statement (None) - - -- Iir_Kind_Wait_Statement (None) - - -- Iir_Kind_Return_Statement (None) - - -- Iir_Kind_Case_Statement (L2) - -- - -- Get/Set_End_Location (Field2) - - -- Iir_Kind_Procedure_Call_Statement (None) - -- Iir_Kind_Concurrent_Procedure_Call_Statement (None) - - -- Iir_Kind_Procedure_Call (None) - - -- Iir_Kind_Null_Statement (None) - - ---------------- - -- operators -- - ---------------- - - -- Iir_Kinds_Monadic_Operator (None) - - -- Iir_Kinds_Dyadic_Operator (None) - - -- Iir_Kind_Function_Call (None) - - -- Iir_Kind_Aggregate (None) - - -- Iir_Kind_Aggregate_Info (None) - - -- Iir_Kind_Parenthesis_Expression (L1) - -- - -- Get/Set_Right_Paren_Location (Field1) - - -- Iir_Kind_Qualified_Expression (None) - - -- Iir_Kind_Type_Conversion (None) - - -- Iir_Kind_Allocator_By_Expression (None) - -- Iir_Kind_Allocator_By_Subtype (None) - - ------------ - -- Names -- - ------------ - - -- Iir_Kind_Simple_Name (None) - -- Iir_Kind_Character_Literal (None) - - -- Iir_Kind_Operator_Symbol (None) - - -- Iir_Kind_Reference_Name (None) - - -- Iir_Kind_Selected_Name (None) - - -- Iir_Kind_Selected_By_All_Name (None) - - -- Iir_Kind_Indexed_Name (None) - - -- Iir_Kind_Slice_Name (None) - - -- Iir_Kind_Parenthesis_Name (None) - - -- Iir_Kind_Selected_Element (None) - - -- Iir_Kind_Implicit_Dereference (None) - -- Iir_Kind_Dereference (None) - - -- Iir_Kind_External_Constant_Name (None) - -- Iir_Kind_External_Signal_Name (None) - -- Iir_Kind_External_Variable_Name (None) - - -- Iir_Kind_Package_Pathname (None) - - -- Iir_Kind_Absolute_Pathname (None) - - -- Iir_Kind_Relative_Pathname (None) - - -- Iir_Kind_Pathname_Element (None) - - ----------------- - -- Attributes -- - ----------------- - - -- Iir_Kind_Attribute_Name (None) - - -- Iir_Kind_Base_Attribute (None) - -- Iir_Kind_Left_Type_Attribute (None) - -- Iir_Kind_Right_Type_Attribute (None) - -- Iir_Kind_High_Type_Attribute (None) - -- Iir_Kind_Low_Type_Attribute (None) - -- Iir_Kind_Ascending_Type_Attribute (None) - - -- Iir_Kind_Range_Array_Attribute (None) - -- Iir_Kind_Reverse_Range_Array_Attribute (None) - -- Iir_Kind_Left_Array_Attribute (None) - -- Iir_Kind_Right_Array_Attribute (None) - -- Iir_Kind_High_Array_Attribute (None) - -- Iir_Kind_Low_Array_Attribute (None) - -- Iir_Kind_Ascending_Array_Attribute (None) - -- Iir_Kind_Length_Array_Attribute (None) - - -- Iir_Kind_Subtype_Attribute (None) - -- Iir_Kind_Element_Attribute (None) - - -- Iir_Kind_Stable_Attribute (None) - -- Iir_Kind_Delayed_Attribute (None) - -- Iir_Kind_Quiet_Attribute (None) - -- Iir_Kind_Transaction_Attribute (None) - -- (Iir_Kinds_Signal_Attribute) - - -- Iir_Kind_Event_Attribute (None) - -- Iir_Kind_Last_Event_Attribute (None) - -- Iir_Kind_Last_Value_Attribute (None) - -- Iir_Kind_Active_Attribute (None) - -- Iir_Kind_Last_Active_Attribute (None) - -- Iir_Kind_Driving_Attribute (None) - -- Iir_Kind_Driving_Value_Attribute (None) - - -- Iir_Kind_Pos_Attribute (None) - -- Iir_Kind_Val_Attribute (None) - -- Iir_Kind_Succ_Attribute (None) - -- Iir_Kind_Pred_Attribute (None) - -- Iir_Kind_Leftof_Attribute (None) - -- Iir_Kind_Rightof_Attribute (None) - - -- Iir_Kind_Image_Attribute (None) - -- Iir_Kind_Value_Attribute (None) - - -- Iir_Kind_Simple_Name_Attribute (None) - -- Iir_Kind_Instance_Name_Attribute (None) - -- Iir_Kind_Path_Name_Attribute (None) - - -- Iir_Kind_Behavior_Attribute (None) - -- Iir_Kind_Structure_Attribute (None) - -- FIXME: to describe (None) - - -- Iir_Kind_Error (None) - - -- Iir_Kind_Unused (None) - - -- End of Iir_Kind. - - -- Allocate memory to store elocations for node N. Must be called once. - procedure Create_Elocations (N : Iir); - - -- Delete locations. Memory is not yet reclaimed (but doesn't happen - -- frequently). - procedure Delete_Elocations (N : Iir); - - -- General methods. - - -- Field: Field1 - function Get_Start_Location (N : Iir) return Location_Type; - procedure Set_Start_Location (N : Iir; Loc : Location_Type); - - -- Field: Field1 - function Get_Right_Paren_Location (N : Iir) return Location_Type; - procedure Set_Right_Paren_Location (N : Iir; Loc : Location_Type); - - -- Field: Field2 - function Get_End_Location (N : Iir) return Location_Type; - procedure Set_End_Location (N : Iir; Loc : Location_Type); - - -- Field: Field4 - function Get_Is_Location (N : Iir) return Location_Type; - procedure Set_Is_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Begin_Location (N : Iir) return Location_Type; - procedure Set_Begin_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Then_Location (N : Iir) return Location_Type; - procedure Set_Then_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Loop_Location (N : Iir) return Location_Type; - procedure Set_Loop_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Generate_Location (N : Iir) return Location_Type; - procedure Set_Generate_Location (N : Iir; Loc : Location_Type); - - -- Field: Field5 - function Get_Generic_Location (N : Iir) return Location_Type; - procedure Set_Generic_Location (N : Iir; Loc : Location_Type); - - -- Field: Field6 - function Get_Port_Location (N : Iir) return Location_Type; - procedure Set_Port_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Generic_Map_Location (N : Iir) return Location_Type; - procedure Set_Generic_Map_Location (N : Iir; Loc : Location_Type); - - -- Field: Field2 - function Get_Port_Map_Location (N : Iir) return Location_Type; - procedure Set_Port_Map_Location (N : Iir; Loc : Location_Type); - - -- Field: Field1 - function Get_Arrow_Location (N : Iir) return Location_Type; - procedure Set_Arrow_Location (N : Iir; Loc : Location_Type); - - -- Field: Field2 - function Get_Colon_Location (N : Iir) return Location_Type; - procedure Set_Colon_Location (N : Iir; Loc : Location_Type); - - -- Field: Field3 - function Get_Assign_Location (N : Iir) return Location_Type; - procedure Set_Assign_Location (N : Iir; Loc : Location_Type); -end Elocations; diff --git a/src/vhdl/elocations_meta.adb b/src/vhdl/elocations_meta.adb deleted file mode 100644 index 1d66236a5..000000000 --- a/src/vhdl/elocations_meta.adb +++ /dev/null @@ -1,405 +0,0 @@ --- Meta description of Elocations. --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Elocations; use Elocations; - -package body Elocations_Meta is - function Get_Field_Image (F : Fields_Enum) return String is - begin - case F is - when Field_Start_Location => - return "start_location"; - when Field_Right_Paren_Location => - return "right_paren_location"; - when Field_End_Location => - return "end_location"; - when Field_Is_Location => - return "is_location"; - when Field_Begin_Location => - return "begin_location"; - when Field_Then_Location => - return "then_location"; - when Field_Loop_Location => - return "loop_location"; - when Field_Generate_Location => - return "generate_location"; - when Field_Generic_Location => - return "generic_location"; - when Field_Port_Location => - return "port_location"; - when Field_Generic_Map_Location => - return "generic_map_location"; - when Field_Port_Map_Location => - return "port_map_location"; - when Field_Arrow_Location => - return "arrow_location"; - when Field_Colon_Location => - return "colon_location"; - when Field_Assign_Location => - return "assign_location"; - end case; - end Get_Field_Image; - - type Field_Type is (Type_Location_Type); - - function Fields_Type (F : Fields_Enum) return Field_Type - is - pragma Unreferenced (F); - begin - return Type_Location_Type; - end Fields_Type; - - pragma Warnings (Off, """others"" choice is redundant"); - - function Get_Location_Type - (N : Iir; F : Fields_Enum) return Location_Type is - begin - pragma Assert (Fields_Type (F) = Type_Location_Type); - case F is - when Field_Start_Location => - return Get_Start_Location (N); - when Field_Right_Paren_Location => - return Get_Right_Paren_Location (N); - when Field_End_Location => - return Get_End_Location (N); - when Field_Is_Location => - return Get_Is_Location (N); - when Field_Begin_Location => - return Get_Begin_Location (N); - when Field_Then_Location => - return Get_Then_Location (N); - when Field_Loop_Location => - return Get_Loop_Location (N); - when Field_Generate_Location => - return Get_Generate_Location (N); - when Field_Generic_Location => - return Get_Generic_Location (N); - when Field_Port_Location => - return Get_Port_Location (N); - when Field_Generic_Map_Location => - return Get_Generic_Map_Location (N); - when Field_Port_Map_Location => - return Get_Port_Map_Location (N); - when Field_Arrow_Location => - return Get_Arrow_Location (N); - when Field_Colon_Location => - return Get_Colon_Location (N); - when Field_Assign_Location => - return Get_Assign_Location (N); - when others => - raise Internal_Error; - end case; - end Get_Location_Type; - - procedure Set_Location_Type - (N : Iir; F : Fields_Enum; V: Location_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Location_Type); - case F is - when Field_Start_Location => - Set_Start_Location (N, V); - when Field_Right_Paren_Location => - Set_Right_Paren_Location (N, V); - when Field_End_Location => - Set_End_Location (N, V); - when Field_Is_Location => - Set_Is_Location (N, V); - when Field_Begin_Location => - Set_Begin_Location (N, V); - when Field_Then_Location => - Set_Then_Location (N, V); - when Field_Loop_Location => - Set_Loop_Location (N, V); - when Field_Generate_Location => - Set_Generate_Location (N, V); - when Field_Generic_Location => - Set_Generic_Location (N, V); - when Field_Port_Location => - Set_Port_Location (N, V); - when Field_Generic_Map_Location => - Set_Generic_Map_Location (N, V); - when Field_Port_Map_Location => - Set_Port_Map_Location (N, V); - when Field_Arrow_Location => - Set_Arrow_Location (N, V); - when Field_Colon_Location => - Set_Colon_Location (N, V); - when Field_Assign_Location => - Set_Assign_Location (N, V); - when others => - raise Internal_Error; - end case; - end Set_Location_Type; - - function Has_Start_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Library_Clause - | Iir_Kind_Attribute_Specification - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Context_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Type_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Simple_Signal_Assignment - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_Generate_Statement_Body - | Iir_Kind_If_Generate_Else_Clause - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Start_Location; - - function Has_Right_Paren_Location (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Parenthesis_Expression; - end Has_Right_Paren_Location; - - function Has_End_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Context_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_Generate_Statement_Body - | Iir_Kind_If_Generate_Else_Clause - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_End_Location; - - function Has_Is_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement => - return True; - when others => - return False; - end case; - end Has_Is_Location; - - function Has_Begin_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement_Body => - return True; - when others => - return False; - end case; - end Has_Begin_Location; - - function Has_Then_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Then_Location; - - function Has_Loop_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement => - return True; - when others => - return False; - end case; - end Has_Loop_Location; - - function Has_Generate_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_If_Generate_Else_Clause => - return True; - when others => - return False; - end case; - end Has_Generate_Location; - - function Has_Generic_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Entity_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Component_Declaration => - return True; - when others => - return False; - end case; - end Has_Generic_Location; - - function Has_Port_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Entity_Declaration - | Iir_Kind_Component_Declaration => - return True; - when others => - return False; - end case; - end Has_Port_Location; - - function Has_Generic_Map_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Component_Instantiation_Statement => - return True; - when others => - return False; - end case; - end Has_Generic_Map_Location; - - function Has_Port_Map_Location (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Component_Instantiation_Statement => - return True; - when others => - return False; - end case; - end Has_Port_Map_Location; - - function Has_Arrow_Location (K : Iir_Kind) return Boolean is - begin - 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_Package - | Iir_Kind_Association_Element_Type - | Iir_Kind_Association_Element_Subprogram => - return True; - when others => - return False; - end case; - end Has_Arrow_Location; - - function Has_Colon_Location (K : Iir_Kind) return Boolean is - begin - case K is - 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; - end case; - end Has_Colon_Location; - - function Has_Assign_Location (K : Iir_Kind) return Boolean is - begin - case K is - 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; - end case; - end Has_Assign_Location; - - - pragma Warnings (On, """others"" choice is redundant"); -end Elocations_Meta; diff --git a/src/vhdl/elocations_meta.adb.in b/src/vhdl/elocations_meta.adb.in deleted file mode 100644 index 279edcfde..000000000 --- a/src/vhdl/elocations_meta.adb.in +++ /dev/null @@ -1,43 +0,0 @@ --- Meta description of Elocations. --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Elocations; use Elocations; - -package body Elocations_Meta is - function Get_Field_Image (F : Fields_Enum) return String is - begin - case F is - -- FIELD_IMAGE - end case; - end Get_Field_Image; - - type Field_Type is (Type_Location_Type); - - function Fields_Type (F : Fields_Enum) return Field_Type - is - pragma Unreferenced (F); - begin - return Type_Location_Type; - end Fields_Type; - - pragma Warnings (Off, """others"" choice is redundant"); - - -- FUNCS_BODY - - pragma Warnings (On, """others"" choice is redundant"); -end Elocations_Meta; diff --git a/src/vhdl/elocations_meta.ads b/src/vhdl/elocations_meta.ads deleted file mode 100644 index 549951408..000000000 --- a/src/vhdl/elocations_meta.ads +++ /dev/null @@ -1,69 +0,0 @@ --- Meta description of elocations --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; - -package Elocations_Meta is - -- The enumeration of all fields defined in iirs. - type Fields_Enum is - ( - Field_Start_Location, - Field_Right_Paren_Location, - Field_End_Location, - Field_Is_Location, - Field_Begin_Location, - Field_Then_Location, - Field_Loop_Location, - Field_Generate_Location, - Field_Generic_Location, - Field_Port_Location, - Field_Generic_Map_Location, - Field_Port_Map_Location, - Field_Arrow_Location, - Field_Colon_Location, - Field_Assign_Location - ); - pragma Discard_Names (Fields_Enum); - - -- Get the name of a field. - function Get_Field_Image (F : Fields_Enum) return String; - - - -- Get/Set a field. - function Get_Location_Type - (N : Iir; F : Fields_Enum) return Location_Type; - procedure Set_Location_Type - (N : Iir; F : Fields_Enum; V: Location_Type); - - function Has_Start_Location (K : Iir_Kind) return Boolean; - function Has_Right_Paren_Location (K : Iir_Kind) return Boolean; - function Has_End_Location (K : Iir_Kind) return Boolean; - function Has_Is_Location (K : Iir_Kind) return Boolean; - function Has_Begin_Location (K : Iir_Kind) return Boolean; - function Has_Then_Location (K : Iir_Kind) return Boolean; - function Has_Loop_Location (K : Iir_Kind) return Boolean; - function Has_Generate_Location (K : Iir_Kind) return Boolean; - function Has_Generic_Location (K : Iir_Kind) return Boolean; - function Has_Port_Location (K : Iir_Kind) return Boolean; - function Has_Generic_Map_Location (K : Iir_Kind) return Boolean; - function Has_Port_Map_Location (K : Iir_Kind) return Boolean; - function Has_Arrow_Location (K : Iir_Kind) return Boolean; - function Has_Colon_Location (K : Iir_Kind) return Boolean; - function Has_Assign_Location (K : Iir_Kind) return Boolean; -end Elocations_Meta; diff --git a/src/vhdl/elocations_meta.ads.in b/src/vhdl/elocations_meta.ads.in deleted file mode 100644 index d8595b143..000000000 --- a/src/vhdl/elocations_meta.ads.in +++ /dev/null @@ -1,36 +0,0 @@ --- Meta description of elocations --- Copyright (C) 2017 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; - -package Elocations_Meta is - -- The enumeration of all fields defined in iirs. - type Fields_Enum is - ( - -- FIELDS - ); - pragma Discard_Names (Fields_Enum); - - -- Get the name of a field. - function Get_Field_Image (F : Fields_Enum) return String; - - - -- Get/Set a field. - -- FUNCS -end Elocations_Meta; diff --git a/src/vhdl/vhdl-elocations.adb b/src/vhdl/vhdl-elocations.adb new file mode 100644 index 000000000..50e775146 --- /dev/null +++ b/src/vhdl/vhdl-elocations.adb @@ -0,0 +1,710 @@ +-- Extended locations for iir nodes +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Tables; +with Nodes; +with Vhdl.Elocations_Meta; use Vhdl.Elocations_Meta; + +package body Vhdl.Elocations is + + -- Format of a node. + type Format_Type is + ( + Format_None, + Format_L1, + Format_L2, + Format_L3, + Format_L4, + Format_L5, + Format_L6 + ); + + -- Common fields are: + + -- Fields of Format_None: + + -- Fields of Format_L1: + -- Field1 : Location_Type + + -- Fields of Format_L2: + -- Field1 : Location_Type + -- Field2 : Location_Type + + -- Fields of Format_L3: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + + -- Fields of Format_L4: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + + -- Fields of Format_L5: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + + -- Fields of Format_L6: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + -- Field6 : Location_Type + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + type Location_Index_Type is new Types.Nat32; + No_Location_Index : constant Location_Index_Type := 0; + + package Elocations_Index_Table is new Tables + (Table_Component_Type => Location_Index_Type, + Table_Index_Type => Iir, + Table_Low_Bound => 2, + Table_Initial => 1024); + + package Elocations_Table is new Tables + (Table_Component_Type => Location_Type, + Table_Index_Type => Location_Index_Type, + Table_Low_Bound => 2, + Table_Initial => 1024); + + procedure Create_Elocations (N : Iir) + is + use Nodes; + Format : constant Format_Type := Get_Format (Get_Kind (N)); + El : constant Iir := Elocations_Index_Table.Last; + Len : Location_Index_Type; + Idx : Location_Index_Type; + begin + pragma Assert (Format /= Format_None); + + if El < N then + Elocations_Index_Table.Set_Last (N); + Elocations_Index_Table.Table (El + 1 .. N) := + (others => No_Location_Index); + end if; + + -- Must be called once. + pragma Assert (Elocations_Index_Table.Table (N) = No_Location_Index); + + case Format is + when Format_None => + raise Program_Error; + when Format_L1 => + Len := 1; + when Format_L2 => + Len := 2; + when Format_L3 => + Len := 3; + when Format_L4 => + Len := 4; + when Format_L5 => + Len := 5; + when Format_L6 => + Len := 6; + end case; + + Idx := Elocations_Table.Last + 1; + Elocations_Index_Table.Table (N) := Idx; + Elocations_Table.Set_Last (Idx + Len - 1); + Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location); + end Create_Elocations; + + procedure Delete_Elocations (N : Iir) is + begin + -- Clear the corresponding index. + Elocations_Index_Table.Table (N) := No_Location_Index; + + -- FIXME: keep free slots in chained list ? + end Delete_Elocations; + + generic + Off : Location_Index_Type; + function Get_FieldX (N : Iir) return Location_Type; + + generic + Off : Location_Index_Type; + procedure Set_FieldX (N : Iir; Loc : Location_Type); + + function Get_FieldX (N : Iir) return Location_Type + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + return Elocations_Table.Table (Idx + Off - 1); + end Get_FieldX; + + procedure Set_FieldX (N : Iir; Loc : Location_Type) + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + Elocations_Table.Table (Idx + Off - 1) := Loc; + end Set_FieldX; + + function Get_Field1 is new Get_FieldX (1); + procedure Set_Field1 is new Set_FieldX (1); + + function Get_Field2 is new Get_FieldX (2); + procedure Set_Field2 is new Set_FieldX (2); + + function Get_Field3 is new Get_FieldX (3); + procedure Set_Field3 is new Set_FieldX (3); + + function Get_Field4 is new Get_FieldX (4); + procedure Set_Field4 is new Set_FieldX (4); + + function Get_Field5 is new Get_FieldX (5); + procedure Set_Field5 is new Set_FieldX (5); + + function Get_Field6 is new Get_FieldX (6); + procedure Set_Field6 is new Set_FieldX (6); + + -- Subprograms + function Get_Format (Kind : Iir_Kind) return Format_Type is + begin + case Kind is + when Iir_Kind_Unused + | Iir_Kind_Error + | Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Use_Clause + | Iir_Kind_Context_Reference + | Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal8 + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Overflow_Literal + | Iir_Kind_Unaffected_Waveform + | Iir_Kind_Waveform_Element + | Iir_Kind_Conditional_Waveform + | Iir_Kind_Conditional_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Entity_Aspect_Configuration + | Iir_Kind_Entity_Aspect_Open + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Binding_Indication + | Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Value + | Iir_Kind_Signature + | Iir_Kind_Aggregate_Info + | Iir_Kind_Procedure_Call + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Array_Element_Resolution + | Iir_Kind_Record_Resolution + | Iir_Kind_Record_Element_Resolution + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_Interface_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Range_Expression + | Iir_Kind_Wildcard_Type_Definition + | Iir_Kind_Subtype_Definition + | Iir_Kind_Scalar_Nature_Definition + | Iir_Kind_Overload_List + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Endpoint_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration + | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_Implicit_Condition_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Psl_Expression + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Case_Generate_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Simple_Signal_Assignment_Statement + | Iir_Kind_Conditional_Signal_Assignment_Statement + | Iir_Kind_Selected_Waveform_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Conditional_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Reference_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Package_Pathname + | Iir_Kind_Absolute_Pathname + | Iir_Kind_Relative_Pathname + | Iir_Kind_Pathname_Element + | Iir_Kind_Base_Attribute + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Element_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Behavior_Attribute + | Iir_Kind_Structure_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return Format_None; + when Iir_Kind_Library_Clause + | Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram + | Iir_Kind_Attribute_Specification + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Interface_Package_Declaration + | Iir_Kind_Parenthesis_Expression + | Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment => + return Format_L1; + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Case_Statement => + return Format_L2; + when Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_If_Generate_Else_Clause + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return Format_L3; + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement => + return Format_L4; + when Iir_Kind_Package_Header => + return Format_L5; + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Component_Declaration => + return Format_L6; + end case; + end Get_Format; + + function Get_Start_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Start_Location (Get_Kind (N)), + "no field Start_Location"); + return Get_Field1 (N); + end Get_Start_Location; + + procedure Set_Start_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Start_Location (Get_Kind (N)), + "no field Start_Location"); + Set_Field1 (N, Loc); + end Set_Start_Location; + + function Get_Right_Paren_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Right_Paren_Location (Get_Kind (N)), + "no field Right_Paren_Location"); + return Get_Field1 (N); + end Get_Right_Paren_Location; + + procedure Set_Right_Paren_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Right_Paren_Location (Get_Kind (N)), + "no field Right_Paren_Location"); + Set_Field1 (N, Loc); + end Set_Right_Paren_Location; + + function Get_End_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_End_Location (Get_Kind (N)), + "no field End_Location"); + return Get_Field2 (N); + end Get_End_Location; + + procedure Set_End_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_End_Location (Get_Kind (N)), + "no field End_Location"); + Set_Field2 (N, Loc); + end Set_End_Location; + + function Get_Is_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Is_Location (Get_Kind (N)), + "no field Is_Location"); + return Get_Field4 (N); + end Get_Is_Location; + + procedure Set_Is_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Is_Location (Get_Kind (N)), + "no field Is_Location"); + Set_Field4 (N, Loc); + end Set_Is_Location; + + function Get_Begin_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Begin_Location (Get_Kind (N)), + "no field Begin_Location"); + return Get_Field3 (N); + end Get_Begin_Location; + + procedure Set_Begin_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Begin_Location (Get_Kind (N)), + "no field Begin_Location"); + Set_Field3 (N, Loc); + end Set_Begin_Location; + + function Get_Then_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Then_Location (Get_Kind (N)), + "no field Then_Location"); + return Get_Field3 (N); + end Get_Then_Location; + + procedure Set_Then_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Then_Location (Get_Kind (N)), + "no field Then_Location"); + Set_Field3 (N, Loc); + end Set_Then_Location; + + function Get_Loop_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Loop_Location (Get_Kind (N)), + "no field Loop_Location"); + return Get_Field3 (N); + end Get_Loop_Location; + + procedure Set_Loop_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Loop_Location (Get_Kind (N)), + "no field Loop_Location"); + Set_Field3 (N, Loc); + end Set_Loop_Location; + + function Get_Generate_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generate_Location (Get_Kind (N)), + "no field Generate_Location"); + return Get_Field3 (N); + end Get_Generate_Location; + + procedure Set_Generate_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generate_Location (Get_Kind (N)), + "no field Generate_Location"); + Set_Field3 (N, Loc); + end Set_Generate_Location; + + function Get_Generic_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generic_Location (Get_Kind (N)), + "no field Generic_Location"); + return Get_Field5 (N); + end Get_Generic_Location; + + procedure Set_Generic_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generic_Location (Get_Kind (N)), + "no field Generic_Location"); + Set_Field5 (N, Loc); + end Set_Generic_Location; + + function Get_Port_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Port_Location (Get_Kind (N)), + "no field Port_Location"); + return Get_Field6 (N); + end Get_Port_Location; + + procedure Set_Port_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Port_Location (Get_Kind (N)), + "no field Port_Location"); + Set_Field6 (N, Loc); + end Set_Port_Location; + + function Get_Generic_Map_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generic_Map_Location (Get_Kind (N)), + "no field Generic_Map_Location"); + return Get_Field3 (N); + end Get_Generic_Map_Location; + + procedure Set_Generic_Map_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Generic_Map_Location (Get_Kind (N)), + "no field Generic_Map_Location"); + Set_Field3 (N, Loc); + end Set_Generic_Map_Location; + + function Get_Port_Map_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Port_Map_Location (Get_Kind (N)), + "no field Port_Map_Location"); + return Get_Field2 (N); + end Get_Port_Map_Location; + + procedure Set_Port_Map_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Port_Map_Location (Get_Kind (N)), + "no field Port_Map_Location"); + Set_Field2 (N, Loc); + end Set_Port_Map_Location; + + function Get_Arrow_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Arrow_Location (Get_Kind (N)), + "no field Arrow_Location"); + return Get_Field1 (N); + end Get_Arrow_Location; + + procedure Set_Arrow_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Arrow_Location (Get_Kind (N)), + "no field Arrow_Location"); + Set_Field1 (N, Loc); + end Set_Arrow_Location; + + function Get_Colon_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Colon_Location (Get_Kind (N)), + "no field Colon_Location"); + return Get_Field2 (N); + end Get_Colon_Location; + + procedure Set_Colon_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Colon_Location (Get_Kind (N)), + "no field Colon_Location"); + Set_Field2 (N, Loc); + end Set_Colon_Location; + + function Get_Assign_Location (N : Iir) return Location_Type is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Assign_Location (Get_Kind (N)), + "no field Assign_Location"); + return Get_Field3 (N); + end Get_Assign_Location; + + procedure Set_Assign_Location (N : Iir; Loc : Location_Type) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Assign_Location (Get_Kind (N)), + "no field Assign_Location"); + Set_Field3 (N, Loc); + end Set_Assign_Location; + +end Vhdl.Elocations; diff --git a/src/vhdl/vhdl-elocations.adb.in b/src/vhdl/vhdl-elocations.adb.in new file mode 100644 index 000000000..1e2827b5f --- /dev/null +++ b/src/vhdl/vhdl-elocations.adb.in @@ -0,0 +1,188 @@ +-- Extended locations for iir nodes +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Tables; +with Nodes; +with Vhdl.Elocations_Meta; use Vhdl.Elocations_Meta; + +package body Vhdl.Elocations is + + -- Format of a node. + type Format_Type is + ( + Format_None, + Format_L1, + Format_L2, + Format_L3, + Format_L4, + Format_L5, + Format_L6 + ); + + -- Common fields are: + + -- Fields of Format_None: + + -- Fields of Format_L1: + -- Field1 : Location_Type + + -- Fields of Format_L2: + -- Field1 : Location_Type + -- Field2 : Location_Type + + -- Fields of Format_L3: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + + -- Fields of Format_L4: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + + -- Fields of Format_L5: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + + -- Fields of Format_L6: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + -- Field6 : Location_Type + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + type Location_Index_Type is new Types.Nat32; + No_Location_Index : constant Location_Index_Type := 0; + + package Elocations_Index_Table is new Tables + (Table_Component_Type => Location_Index_Type, + Table_Index_Type => Iir, + Table_Low_Bound => 2, + Table_Initial => 1024); + + package Elocations_Table is new Tables + (Table_Component_Type => Location_Type, + Table_Index_Type => Location_Index_Type, + Table_Low_Bound => 2, + Table_Initial => 1024); + + procedure Create_Elocations (N : Iir) + is + use Nodes; + Format : constant Format_Type := Get_Format (Get_Kind (N)); + El : constant Iir := Elocations_Index_Table.Last; + Len : Location_Index_Type; + Idx : Location_Index_Type; + begin + pragma Assert (Format /= Format_None); + + if El < N then + Elocations_Index_Table.Set_Last (N); + Elocations_Index_Table.Table (El + 1 .. N) := + (others => No_Location_Index); + end if; + + -- Must be called once. + pragma Assert (Elocations_Index_Table.Table (N) = No_Location_Index); + + case Format is + when Format_None => + raise Program_Error; + when Format_L1 => + Len := 1; + when Format_L2 => + Len := 2; + when Format_L3 => + Len := 3; + when Format_L4 => + Len := 4; + when Format_L5 => + Len := 5; + when Format_L6 => + Len := 6; + end case; + + Idx := Elocations_Table.Last + 1; + Elocations_Index_Table.Table (N) := Idx; + Elocations_Table.Set_Last (Idx + Len - 1); + Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location); + end Create_Elocations; + + procedure Delete_Elocations (N : Iir) is + begin + -- Clear the corresponding index. + Elocations_Index_Table.Table (N) := No_Location_Index; + + -- FIXME: keep free slots in chained list ? + end Delete_Elocations; + + generic + Off : Location_Index_Type; + function Get_FieldX (N : Iir) return Location_Type; + + generic + Off : Location_Index_Type; + procedure Set_FieldX (N : Iir; Loc : Location_Type); + + function Get_FieldX (N : Iir) return Location_Type + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + return Elocations_Table.Table (Idx + Off - 1); + end Get_FieldX; + + procedure Set_FieldX (N : Iir; Loc : Location_Type) + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + Elocations_Table.Table (Idx + Off - 1) := Loc; + end Set_FieldX; + + function Get_Field1 is new Get_FieldX (1); + procedure Set_Field1 is new Set_FieldX (1); + + function Get_Field2 is new Get_FieldX (2); + procedure Set_Field2 is new Set_FieldX (2); + + function Get_Field3 is new Get_FieldX (3); + procedure Set_Field3 is new Set_FieldX (3); + + function Get_Field4 is new Get_FieldX (4); + procedure Set_Field4 is new Set_FieldX (4); + + function Get_Field5 is new Get_FieldX (5); + procedure Set_Field5 is new Set_FieldX (5); + + function Get_Field6 is new Get_FieldX (6); + procedure Set_Field6 is new Set_FieldX (6); + + -- Subprograms +end Vhdl.Elocations; diff --git a/src/vhdl/vhdl-elocations.ads b/src/vhdl/vhdl-elocations.ads new file mode 100644 index 000000000..8772aec1b --- /dev/null +++ b/src/vhdl/vhdl-elocations.ads @@ -0,0 +1,699 @@ +-- Extended locations for iir nodes +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; + +package Vhdl.Elocations is + + -- Start of Iir_Kind. + + -- Iir_Kind_Design_File (None) + + -- Iir_Kind_Design_Unit (None) + + -- Iir_Kind_Library_Clause (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_String_Literal8 (None) + + -- Iir_Kind_Integer_Literal (None) + + -- Iir_Kind_Floating_Point_Literal (None) + + -- Iir_Kind_Null_Literal (None) + + -- Iir_Kind_Physical_Int_Literal (None) + -- Iir_Kind_Physical_Fp_Literal (None) + + -- Iir_Kind_Simple_Aggregate (None) + + -- Iir_Kind_Overflow_Literal (None) + + -- Iir_Kind_Unaffected_Waveform (None) + + ------------- + -- Tuples -- + ------------- + + -- Iir_Kind_Association_Element_By_Expression (L1) + -- Iir_Kind_Association_Element_Open (L1) + -- Iir_Kind_Association_Element_By_Individual (L1) + -- Iir_Kind_Association_Element_Package (L1) + -- Iir_Kind_Association_Element_Type (L1) + -- Iir_Kind_Association_Element_Subprogram (L1) + -- + -- Get/Set_Arrow_Location (Field1) + + -- Iir_Kind_Waveform_Element (None) + + -- Iir_Kind_Conditional_Waveform (None) + + -- Iir_Kind_Conditional_Expression (None) + + -- Iir_Kind_Choice_By_Others (None) + -- Iir_Kind_Choice_By_None (None) + -- Iir_Kind_Choice_By_Range (None) + -- Iir_Kind_Choice_By_Name (None) + -- Iir_Kind_Choice_By_Expression (None) + + -- Iir_Kind_Entity_Aspect_Entity (None) + + -- Iir_Kind_Entity_Aspect_Open (None) + + -- Iir_Kind_Entity_Aspect_Configuration (None) + + -- Iir_Kind_Block_Configuration (None) + + -- Iir_Kind_Binding_Indication (None) + + -- Iir_Kind_Component_Configuration (None) + -- Iir_Kind_Configuration_Specification (None) + + -- Iir_Kind_Disconnection_Specification (None) + + -- Iir_Kind_Block_Header (L6) + -- + -- Get/Set_Generic_Location (Field5) + -- + -- Get/Set_Port_Location (Field6) + -- + -- Get/Set_Generic_Map_Location (Field3) + -- + -- Get/Set_Port_Map_Location (Field2) + + -- Iir_Kind_Entity_Class (None) + + -- Iir_Kind_Attribute_Specification (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Attribute_Value (None) + + -- Iir_Kind_Psl_Expression (None) + + -- Iir_Kind_Signature (None) + + -- Iir_Kind_Overload_List (None) + + ------------------- + -- Declarations -- + ------------------- + + -- Iir_Kind_Entity_Declaration (L6) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generic_Location (Field5) + -- + -- Get/Set_Port_Location (Field6) + -- + -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Architecture_Body (L4) + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Configuration_Declaration (L2) + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Package_Header (L5) + -- + -- Get/Set_Generic_Location (Field5) + -- + -- Get/Set_Generic_Map_Location (Field3) + + -- Iir_Kind_Package_Declaration (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Package_Body (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Package_Instantiation_Declaration (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Correspond to the final ';'. + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generic_Map_Location (Field3) + + -- Iir_Kind_Context_Declaration (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Library_Declaration (None) + + -- Iir_Kind_Component_Declaration (L6) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generic_Location (Field5) + -- + -- Get/Set_Port_Location (Field6) + + -- Iir_Kind_Object_Alias_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Non_Object_Alias_Declaration (None) + + -- Iir_Kind_Anonymous_Type_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Type_Declaration (L4) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Subtype_Declaration (L4) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Nature_Declaration (None) + + -- Iir_Kind_Subnature_Declaration (None) + + -- Iir_Kind_Interface_Signal_Declaration (L3) + -- Iir_Kind_Interface_Constant_Declaration (L3) + -- Iir_Kind_Interface_Variable_Declaration (L3) + -- Iir_Kind_Interface_File_Declaration (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_Colon_Location (Field2) + -- + -- Get/Set_Assign_Location (Field3) + + -- Iir_Kind_Interface_Type_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Interface_Package_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Function_Declaration (L1) + -- Iir_Kind_Procedure_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Function_Body (L4) + -- Iir_Kind_Procedure_Body (L4) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Interface_Function_Declaration (None) + -- Iir_Kind_Interface_Procedure_Declaration (None) + + -- Iir_Kind_Signal_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Guard_Signal_Declaration (None) + + -- Iir_Kind_Signal_Attribute_Declaration (None) + + -- Iir_Kind_Constant_Declaration (L1) + -- Iir_Kind_Iterator_Declaration (L1) + -- Iir_Kind_Variable_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_File_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Element_Declaration (None) + + -- Iir_Kind_Record_Resolution (None) + + -- Iir_Kind_Record_Element_Constraint (None) + + -- Iir_Kind_Attribute_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Group_Template_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Group_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Psl_Endpoint_Declaration (None) + + -- Iir_Kind_Psl_Declaration (None) + + -- Iir_Kind_Terminal_Declaration (None) + + -- Iir_Kind_Free_Quantity_Declaration (None) + + -- Iir_Kind_Across_Quantity_Declaration (None) + -- Iir_Kind_Through_Quantity_Declaration (None) + + -- Iir_Kind_Use_Clause (None) + + -- Iir_Kind_Context_Reference (None) + + ----------------------- + -- type definitions -- + ----------------------- + + -- Iir_Kind_Enumeration_Type_Definition (None) + + -- Iir_Kind_Enumeration_Literal (None) + + -- Iir_Kind_Physical_Type_Definition (None) + + -- Iir_Kind_Unit_Declaration (None) + + -- Iir_Kind_Integer_Type_Definition (None) + -- Iir_Kind_Floating_Type_Definition (None) + + -- Iir_Kind_Array_Type_Definition (None) + + -- Iir_Kind_Record_Type_Definition (L2) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Access_Type_Definition (None) + + -- Iir_Kind_File_Type_Definition (None) + + -- Iir_Kind_Incomplete_Type_Definition (None) + + -- Iir_Kind_Interface_Type_Definition (None) + + -- Iir_Kind_Protected_Type_Declaration (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Protected_Type_Body (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Wildcard_Type_Definition (None) + + -------------------------- + -- subtype definitions -- + -------------------------- + + -- Iir_Kind_Enumeration_Subtype_Definition (None) + -- Iir_Kind_Integer_Subtype_Definition (None) + -- Iir_Kind_Physical_Subtype_Definition (None) + + -- Iir_Kind_Floating_Subtype_Definition (None) + + -- Iir_Kind_Access_Subtype_Definition (None) + + -- Iir_Kind_Array_Element_Resolution (None) + + -- Iir_Kind_Record_Element_Resolution (None) + + -- Iir_Kind_Record_Subtype_Definition (None) + + -- Iir_Kind_Array_Subtype_Definition (None) + + -- Iir_Kind_Range_Expression (None) + + -- Iir_Kind_Subtype_Definition (None) + + ------------------------- + -- Nature definitions -- + ------------------------- + + -- Iir_Kind_Scalar_Nature_Definition (None) + + ---------------------------- + -- concurrent statements -- + ---------------------------- + + -- Iir_Kind_Concurrent_Conditional_Signal_Assignment (L1) + -- Iir_Kind_Concurrent_Selected_Signal_Assignment (L1) + -- Iir_Kind_Concurrent_Simple_Signal_Assignment (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Sensitized_Process_Statement (L4) + -- Iir_Kind_Process_Statement (L4) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Concurrent_Assertion_Statement (None) + + -- Iir_Kind_Psl_Default_Clock (None) + + -- Iir_Kind_Psl_Assert_Statement (None) + -- Iir_Kind_Psl_Cover_Statement (None) + + -- Iir_Kind_Component_Instantiation_Statement (L3) + -- + -- Get/Set_Generic_Map_Location (Field3) + -- + -- Get/Set_Port_Map_Location (Field2) + + -- Iir_Kind_Block_Statement (L4) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) + + -- Iir_Kind_Generate_Statement_Body (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + + -- Iir_Kind_For_Generate_Statement (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generate_Location (Field3) + + -- Iir_Kind_If_Generate_Else_Clause (L3) + -- Iir_Kind_If_Generate_Statement (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generate_Location (Field3) + + -- Iir_Kind_Case_Generate_Statement (None) + + -- Iir_Kind_Simple_Simultaneous_Statement (None) + + ---------------------------- + -- sequential statements -- + ---------------------------- + + -- Iir_Kind_If_Statement (L3) + -- Iir_Kind_Elsif (L3) + -- + -- Location of 'if', 'else' or 'elsif'. + -- Get/Set_Start_Location (Field1) + -- + -- Location of the next 'elsif', 'else' or 'end if'. + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Then_Location (Field3) + + -- Iir_Kind_For_Loop_Statement (L3) + -- Iir_Kind_While_Loop_Statement (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Loop_Location (Field3) + + -- Iir_Kind_Exit_Statement (None) + -- Iir_Kind_Next_Statement (None) + + -- Iir_Kind_Simple_Signal_Assignment_Statement (None) + -- Iir_Kind_Conditional_Signal_Assignment_Statement (None) + -- Iir_Kind_Selected_Waveform_Assignment_Statement (None) + + -- Iir_Kind_Variable_Assignment_Statement (None) + + -- Iir_Kind_Conditional_Variable_Assignment_Statement (None) + + -- Iir_Kind_Assertion_Statement (None) + + -- Iir_Kind_Report_Statement (None) + + -- Iir_Kind_Wait_Statement (None) + + -- Iir_Kind_Return_Statement (None) + + -- Iir_Kind_Case_Statement (L2) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Procedure_Call_Statement (None) + -- Iir_Kind_Concurrent_Procedure_Call_Statement (None) + + -- Iir_Kind_Procedure_Call (None) + + -- Iir_Kind_Null_Statement (None) + + ---------------- + -- operators -- + ---------------- + + -- Iir_Kinds_Monadic_Operator (None) + + -- Iir_Kinds_Dyadic_Operator (None) + + -- Iir_Kind_Function_Call (None) + + -- Iir_Kind_Aggregate (None) + + -- Iir_Kind_Aggregate_Info (None) + + -- Iir_Kind_Parenthesis_Expression (L1) + -- + -- Get/Set_Right_Paren_Location (Field1) + + -- Iir_Kind_Qualified_Expression (None) + + -- Iir_Kind_Type_Conversion (None) + + -- Iir_Kind_Allocator_By_Expression (None) + -- Iir_Kind_Allocator_By_Subtype (None) + + ------------ + -- Names -- + ------------ + + -- Iir_Kind_Simple_Name (None) + -- Iir_Kind_Character_Literal (None) + + -- Iir_Kind_Operator_Symbol (None) + + -- Iir_Kind_Reference_Name (None) + + -- Iir_Kind_Selected_Name (None) + + -- Iir_Kind_Selected_By_All_Name (None) + + -- Iir_Kind_Indexed_Name (None) + + -- Iir_Kind_Slice_Name (None) + + -- Iir_Kind_Parenthesis_Name (None) + + -- Iir_Kind_Selected_Element (None) + + -- Iir_Kind_Implicit_Dereference (None) + -- Iir_Kind_Dereference (None) + + -- Iir_Kind_External_Constant_Name (None) + -- Iir_Kind_External_Signal_Name (None) + -- Iir_Kind_External_Variable_Name (None) + + -- Iir_Kind_Package_Pathname (None) + + -- Iir_Kind_Absolute_Pathname (None) + + -- Iir_Kind_Relative_Pathname (None) + + -- Iir_Kind_Pathname_Element (None) + + ----------------- + -- Attributes -- + ----------------- + + -- Iir_Kind_Attribute_Name (None) + + -- Iir_Kind_Base_Attribute (None) + -- Iir_Kind_Left_Type_Attribute (None) + -- Iir_Kind_Right_Type_Attribute (None) + -- Iir_Kind_High_Type_Attribute (None) + -- Iir_Kind_Low_Type_Attribute (None) + -- Iir_Kind_Ascending_Type_Attribute (None) + + -- Iir_Kind_Range_Array_Attribute (None) + -- Iir_Kind_Reverse_Range_Array_Attribute (None) + -- Iir_Kind_Left_Array_Attribute (None) + -- Iir_Kind_Right_Array_Attribute (None) + -- Iir_Kind_High_Array_Attribute (None) + -- Iir_Kind_Low_Array_Attribute (None) + -- Iir_Kind_Ascending_Array_Attribute (None) + -- Iir_Kind_Length_Array_Attribute (None) + + -- Iir_Kind_Subtype_Attribute (None) + -- Iir_Kind_Element_Attribute (None) + + -- Iir_Kind_Stable_Attribute (None) + -- Iir_Kind_Delayed_Attribute (None) + -- Iir_Kind_Quiet_Attribute (None) + -- Iir_Kind_Transaction_Attribute (None) + -- (Iir_Kinds_Signal_Attribute) + + -- Iir_Kind_Event_Attribute (None) + -- Iir_Kind_Last_Event_Attribute (None) + -- Iir_Kind_Last_Value_Attribute (None) + -- Iir_Kind_Active_Attribute (None) + -- Iir_Kind_Last_Active_Attribute (None) + -- Iir_Kind_Driving_Attribute (None) + -- Iir_Kind_Driving_Value_Attribute (None) + + -- Iir_Kind_Pos_Attribute (None) + -- Iir_Kind_Val_Attribute (None) + -- Iir_Kind_Succ_Attribute (None) + -- Iir_Kind_Pred_Attribute (None) + -- Iir_Kind_Leftof_Attribute (None) + -- Iir_Kind_Rightof_Attribute (None) + + -- Iir_Kind_Image_Attribute (None) + -- Iir_Kind_Value_Attribute (None) + + -- Iir_Kind_Simple_Name_Attribute (None) + -- Iir_Kind_Instance_Name_Attribute (None) + -- Iir_Kind_Path_Name_Attribute (None) + + -- Iir_Kind_Behavior_Attribute (None) + -- Iir_Kind_Structure_Attribute (None) + -- FIXME: to describe (None) + + -- Iir_Kind_Error (None) + + -- Iir_Kind_Unused (None) + + -- End of Iir_Kind. + + -- Allocate memory to store elocations for node N. Must be called once. + procedure Create_Elocations (N : Iir); + + -- Delete locations. Memory is not yet reclaimed (but doesn't happen + -- frequently). + procedure Delete_Elocations (N : Iir); + + -- General methods. + + -- Field: Field1 + function Get_Start_Location (N : Iir) return Location_Type; + procedure Set_Start_Location (N : Iir; Loc : Location_Type); + + -- Field: Field1 + function Get_Right_Paren_Location (N : Iir) return Location_Type; + procedure Set_Right_Paren_Location (N : Iir; Loc : Location_Type); + + -- Field: Field2 + function Get_End_Location (N : Iir) return Location_Type; + procedure Set_End_Location (N : Iir; Loc : Location_Type); + + -- Field: Field4 + function Get_Is_Location (N : Iir) return Location_Type; + procedure Set_Is_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Begin_Location (N : Iir) return Location_Type; + procedure Set_Begin_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Then_Location (N : Iir) return Location_Type; + procedure Set_Then_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Loop_Location (N : Iir) return Location_Type; + procedure Set_Loop_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Generate_Location (N : Iir) return Location_Type; + procedure Set_Generate_Location (N : Iir; Loc : Location_Type); + + -- Field: Field5 + function Get_Generic_Location (N : Iir) return Location_Type; + procedure Set_Generic_Location (N : Iir; Loc : Location_Type); + + -- Field: Field6 + function Get_Port_Location (N : Iir) return Location_Type; + procedure Set_Port_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Generic_Map_Location (N : Iir) return Location_Type; + procedure Set_Generic_Map_Location (N : Iir; Loc : Location_Type); + + -- Field: Field2 + function Get_Port_Map_Location (N : Iir) return Location_Type; + procedure Set_Port_Map_Location (N : Iir; Loc : Location_Type); + + -- Field: Field1 + function Get_Arrow_Location (N : Iir) return Location_Type; + procedure Set_Arrow_Location (N : Iir; Loc : Location_Type); + + -- Field: Field2 + function Get_Colon_Location (N : Iir) return Location_Type; + procedure Set_Colon_Location (N : Iir; Loc : Location_Type); + + -- Field: Field3 + function Get_Assign_Location (N : Iir) return Location_Type; + procedure Set_Assign_Location (N : Iir; Loc : Location_Type); +end Vhdl.Elocations; diff --git a/src/vhdl/vhdl-elocations_meta.adb b/src/vhdl/vhdl-elocations_meta.adb new file mode 100644 index 000000000..0b993f62c --- /dev/null +++ b/src/vhdl/vhdl-elocations_meta.adb @@ -0,0 +1,405 @@ +-- Meta description of Elocations. +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Vhdl.Elocations; use Vhdl.Elocations; + +package body Vhdl.Elocations_Meta is + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + when Field_Start_Location => + return "start_location"; + when Field_Right_Paren_Location => + return "right_paren_location"; + when Field_End_Location => + return "end_location"; + when Field_Is_Location => + return "is_location"; + when Field_Begin_Location => + return "begin_location"; + when Field_Then_Location => + return "then_location"; + when Field_Loop_Location => + return "loop_location"; + when Field_Generate_Location => + return "generate_location"; + when Field_Generic_Location => + return "generic_location"; + when Field_Port_Location => + return "port_location"; + when Field_Generic_Map_Location => + return "generic_map_location"; + when Field_Port_Map_Location => + return "port_map_location"; + when Field_Arrow_Location => + return "arrow_location"; + when Field_Colon_Location => + return "colon_location"; + when Field_Assign_Location => + return "assign_location"; + end case; + end Get_Field_Image; + + type Field_Type is (Type_Location_Type); + + function Fields_Type (F : Fields_Enum) return Field_Type + is + pragma Unreferenced (F); + begin + return Type_Location_Type; + end Fields_Type; + + pragma Warnings (Off, """others"" choice is redundant"); + + function Get_Location_Type + (N : Iir; F : Fields_Enum) return Location_Type is + begin + pragma Assert (Fields_Type (F) = Type_Location_Type); + case F is + when Field_Start_Location => + return Get_Start_Location (N); + when Field_Right_Paren_Location => + return Get_Right_Paren_Location (N); + when Field_End_Location => + return Get_End_Location (N); + when Field_Is_Location => + return Get_Is_Location (N); + when Field_Begin_Location => + return Get_Begin_Location (N); + when Field_Then_Location => + return Get_Then_Location (N); + when Field_Loop_Location => + return Get_Loop_Location (N); + when Field_Generate_Location => + return Get_Generate_Location (N); + when Field_Generic_Location => + return Get_Generic_Location (N); + when Field_Port_Location => + return Get_Port_Location (N); + when Field_Generic_Map_Location => + return Get_Generic_Map_Location (N); + when Field_Port_Map_Location => + return Get_Port_Map_Location (N); + when Field_Arrow_Location => + return Get_Arrow_Location (N); + when Field_Colon_Location => + return Get_Colon_Location (N); + when Field_Assign_Location => + return Get_Assign_Location (N); + when others => + raise Internal_Error; + end case; + end Get_Location_Type; + + procedure Set_Location_Type + (N : Iir; F : Fields_Enum; V: Location_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Location_Type); + case F is + when Field_Start_Location => + Set_Start_Location (N, V); + when Field_Right_Paren_Location => + Set_Right_Paren_Location (N, V); + when Field_End_Location => + Set_End_Location (N, V); + when Field_Is_Location => + Set_Is_Location (N, V); + when Field_Begin_Location => + Set_Begin_Location (N, V); + when Field_Then_Location => + Set_Then_Location (N, V); + when Field_Loop_Location => + Set_Loop_Location (N, V); + when Field_Generate_Location => + Set_Generate_Location (N, V); + when Field_Generic_Location => + Set_Generic_Location (N, V); + when Field_Port_Location => + Set_Port_Location (N, V); + when Field_Generic_Map_Location => + Set_Generic_Map_Location (N, V); + when Field_Port_Map_Location => + Set_Port_Map_Location (N, V); + when Field_Arrow_Location => + Set_Arrow_Location (N, V); + when Field_Colon_Location => + Set_Colon_Location (N, V); + when Field_Assign_Location => + Set_Assign_Location (N, V); + when others => + raise Internal_Error; + end case; + end Set_Location_Type; + + function Has_Start_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Library_Clause + | Iir_Kind_Attribute_Specification + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Body + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Interface_Package_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_If_Generate_Else_Clause + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Start_Location; + + function Has_Right_Paren_Location (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Parenthesis_Expression; + end Has_Right_Paren_Location; + + function Has_End_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Body + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_If_Generate_Else_Clause + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_End_Location; + + function Has_Is_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement => + return True; + when others => + return False; + end case; + end Has_Is_Location; + + function Has_Begin_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement_Body => + return True; + when others => + return False; + end case; + end Has_Begin_Location; + + function Has_Then_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Then_Location; + + function Has_Loop_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement => + return True; + when others => + return False; + end case; + end Has_Loop_Location; + + function Has_Generate_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause => + return True; + when others => + return False; + end case; + end Has_Generate_Location; + + function Has_Generic_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Header + | Iir_Kind_Component_Declaration => + return True; + when others => + return False; + end case; + end Has_Generic_Location; + + function Has_Port_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Component_Declaration => + return True; + when others => + return False; + end case; + end Has_Port_Location; + + function Has_Generic_Map_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Header + | Iir_Kind_Component_Instantiation_Statement => + return True; + when others => + return False; + end case; + end Has_Generic_Map_Location; + + function Has_Port_Map_Location (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Component_Instantiation_Statement => + return True; + when others => + return False; + end case; + end Has_Port_Map_Location; + + function Has_Arrow_Location (K : Iir_Kind) return Boolean is + begin + 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_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram => + return True; + when others => + return False; + end case; + end Has_Arrow_Location; + + function Has_Colon_Location (K : Iir_Kind) return Boolean is + begin + case K is + 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; + end case; + end Has_Colon_Location; + + function Has_Assign_Location (K : Iir_Kind) return Boolean is + begin + case K is + 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; + end case; + end Has_Assign_Location; + + + pragma Warnings (On, """others"" choice is redundant"); +end Vhdl.Elocations_Meta; diff --git a/src/vhdl/vhdl-elocations_meta.adb.in b/src/vhdl/vhdl-elocations_meta.adb.in new file mode 100644 index 000000000..f5dde00c6 --- /dev/null +++ b/src/vhdl/vhdl-elocations_meta.adb.in @@ -0,0 +1,43 @@ +-- Meta description of Elocations. +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Vhdl.Elocations; use Vhdl.Elocations; + +package body Vhdl.Elocations_Meta is + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + -- FIELD_IMAGE + end case; + end Get_Field_Image; + + type Field_Type is (Type_Location_Type); + + function Fields_Type (F : Fields_Enum) return Field_Type + is + pragma Unreferenced (F); + begin + return Type_Location_Type; + end Fields_Type; + + pragma Warnings (Off, """others"" choice is redundant"); + + -- FUNCS_BODY + + pragma Warnings (On, """others"" choice is redundant"); +end Vhdl.Elocations_Meta; diff --git a/src/vhdl/vhdl-elocations_meta.ads b/src/vhdl/vhdl-elocations_meta.ads new file mode 100644 index 000000000..ad389daca --- /dev/null +++ b/src/vhdl/vhdl-elocations_meta.ads @@ -0,0 +1,69 @@ +-- Meta description of elocations +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; + +package Vhdl.Elocations_Meta is + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + Field_Start_Location, + Field_Right_Paren_Location, + Field_End_Location, + Field_Is_Location, + Field_Begin_Location, + Field_Then_Location, + Field_Loop_Location, + Field_Generate_Location, + Field_Generic_Location, + Field_Port_Location, + Field_Generic_Map_Location, + Field_Port_Map_Location, + Field_Arrow_Location, + Field_Colon_Location, + Field_Assign_Location + ); + pragma Discard_Names (Fields_Enum); + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + + -- Get/Set a field. + function Get_Location_Type + (N : Iir; F : Fields_Enum) return Location_Type; + procedure Set_Location_Type + (N : Iir; F : Fields_Enum; V: Location_Type); + + function Has_Start_Location (K : Iir_Kind) return Boolean; + function Has_Right_Paren_Location (K : Iir_Kind) return Boolean; + function Has_End_Location (K : Iir_Kind) return Boolean; + function Has_Is_Location (K : Iir_Kind) return Boolean; + function Has_Begin_Location (K : Iir_Kind) return Boolean; + function Has_Then_Location (K : Iir_Kind) return Boolean; + function Has_Loop_Location (K : Iir_Kind) return Boolean; + function Has_Generate_Location (K : Iir_Kind) return Boolean; + function Has_Generic_Location (K : Iir_Kind) return Boolean; + function Has_Port_Location (K : Iir_Kind) return Boolean; + function Has_Generic_Map_Location (K : Iir_Kind) return Boolean; + function Has_Port_Map_Location (K : Iir_Kind) return Boolean; + function Has_Arrow_Location (K : Iir_Kind) return Boolean; + function Has_Colon_Location (K : Iir_Kind) return Boolean; + function Has_Assign_Location (K : Iir_Kind) return Boolean; +end Vhdl.Elocations_Meta; diff --git a/src/vhdl/vhdl-elocations_meta.ads.in b/src/vhdl/vhdl-elocations_meta.ads.in new file mode 100644 index 000000000..dfbce3296 --- /dev/null +++ b/src/vhdl/vhdl-elocations_meta.ads.in @@ -0,0 +1,36 @@ +-- Meta description of elocations +-- Copyright (C) 2017 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; + +package Vhdl.Elocations_Meta is + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + -- FIELDS + ); + pragma Discard_Names (Fields_Enum); + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + + -- Get/Set a field. + -- FUNCS +end Vhdl.Elocations_Meta; diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index fc45ff965..4c39d91bb 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -25,7 +25,7 @@ with Flags; use Flags; with Vhdl.Parse_Psl; with Str_Table; with Xrefs; -with Elocations; use Elocations; +with Vhdl.Elocations; use Vhdl.Elocations; -- Recursive descendant parser. -- Each subprogram (should) parse one production rules. -- cgit v1.2.3