Add generated files for elocations.

3 files changed, 951 insertions, 0 deletions

diff --git a/src/vhdl/elocations.adb b/src/vhdl/elocations.adb
new file mode 100644
index 000000000..a73ce1ca4
--- /dev/null
+++ b/src/vhdl/elocations.adb
@@ -0,0 +1,596 @@
+--  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_L5
+     );
+
+   -- 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_L5:
+   --   Field1 : Location_Type
+   --   Field2 : Location_Type
+   --   Field3 : Location_Type
+   --   Field4 : Location_Type
+   --   Field5 : 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_L5 =>
+            Len := 5;
+      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;
+
+   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);
+
+   --  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_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_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_Attribute_Specification
+           | 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_Anonymous_Type_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Element_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_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_Parenthesis_Expression
+           | 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_If_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
+           | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_If_Generate_Else_Clause
+           | 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_While_Loop_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_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_External_Constant_Name
+           | Iir_Kind_External_Signal_Name
+           | Iir_Kind_External_Variable_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_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Non_Object_Alias_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_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_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_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Context_Declaration
+           | Iir_Kind_Case_Statement =>
+            return Format_L2;
+         when Iir_Kind_Package_Instantiation_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_Component_Instantiation_Statement
+           | Iir_Kind_Generate_Statement_Body
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return Format_L3;
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Header
+           | Iir_Kind_Component_Declaration =>
+            return Format_L5;
+      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_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_Field2 (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_Field2 (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_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_Field4 (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_Field4 (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_Field5 (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_Field5 (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;
+
+end Elocations;
diff --git a/src/vhdl/elocations_meta.adb b/src/vhdl/elocations_meta.adb
new file mode 100644
index 000000000..b76e251fd
--- /dev/null
+++ b/src/vhdl/elocations_meta.adb
@@ -0,0 +1,296 @@
+--  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_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_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";
+      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_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_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 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_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_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 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_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Context_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Non_Object_Alias_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_Generate_Statement_Body
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Start_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_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Context_Declaration
+           | 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_Generate_Statement_Body
+           | Iir_Kind_For_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 =>
+            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
+      return K = Iir_Kind_For_Loop_Statement;
+   end Has_Loop_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;
+
+
+   pragma Warnings (On, """others"" choice is redundant");
+end Elocations_Meta;
diff --git a/src/vhdl/elocations_meta.ads b/src/vhdl/elocations_meta.ads
new file mode 100644
index 000000000..4bde59559
--- /dev/null
+++ b/src/vhdl/elocations_meta.ads
@@ -0,0 +1,59 @@
+--  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_End_Location,
+      Field_Is_Location,
+      Field_Begin_Location,
+      Field_Then_Location,
+      Field_Loop_Location,
+      Field_Generic_Location,
+      Field_Port_Location,
+      Field_Generic_Map_Location,
+      Field_Port_Map_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_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_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;
+end Elocations_Meta;