diff options
author | Tristan Gingold <tgingold@free.fr> | 2017-10-18 05:42:47 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2017-10-18 05:42:47 +0200 |
commit | 8d2bc284f030ab3ade000f11520dfbf9d8995c69 (patch) | |
tree | 494ae66cf7266fe8e173a3e0a7d77b418788a89a /src | |
parent | 95bbe2124734f4687e37455d6efb7935a0ee97a3 (diff) | |
download | ghdl-8d2bc284f030ab3ade000f11520dfbf9d8995c69.tar.gz ghdl-8d2bc284f030ab3ade000f11520dfbf9d8995c69.tar.bz2 ghdl-8d2bc284f030ab3ade000f11520dfbf9d8995c69.zip |
Add extended locations (elocations). Still WIP
Diffstat (limited to 'src')
-rw-r--r-- | src/flags.ads | 6 | ||||
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 4 | ||||
-rw-r--r-- | src/ghdldrv/ghdlxml.adb | 8 | ||||
-rw-r--r-- | src/vhdl/Makefile | 27 | ||||
-rw-r--r-- | src/vhdl/disp_tree.adb | 3 | ||||
-rw-r--r-- | src/vhdl/elocations.adb.in | 157 | ||||
-rw-r--r-- | src/vhdl/elocations.ads | 647 | ||||
-rw-r--r-- | src/vhdl/elocations_meta.adb.in | 43 | ||||
-rw-r--r-- | src/vhdl/elocations_meta.ads.in | 36 | ||||
-rw-r--r-- | src/vhdl/iirs.adb | 26 | ||||
-rw-r--r-- | src/vhdl/iirs.adb.in | 10 | ||||
-rw-r--r-- | src/vhdl/iirs.ads | 17 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.adb | 565 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.ads | 8 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 483 | ||||
-rw-r--r-- | src/vhdl/python/libghdl/thin.py | 5 | ||||
-rwxr-xr-x | src/vhdl/python/pnodespy.py | 16 | ||||
-rw-r--r-- | src/vhdl/sem_inst.adb | 3 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 1 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 1 |
20 files changed, 1583 insertions, 483 deletions
diff --git a/src/flags.ads b/src/flags.ads index cdcdd0202..f9c0be2a1 100644 --- a/src/flags.ads +++ b/src/flags.ads @@ -94,6 +94,12 @@ package Flags is -- -v: disp phase of compilation. Verbose : Boolean := False; + -- If set to true, the parser builds extended locations (defined in + -- package elocations). This saves possibly many locations per node, so + -- it uses more memory. Useful when a tool (like a style checker) wants + -- to know the precise layout. Not used to report errors. + Flag_Elocations : Boolean := False; + -- If set to true, it means that analyze is done for elaboration. -- The purpose is to avoid spurious warning "will be checked -- at elaboration" diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 97689082a..a19085527 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -36,6 +36,7 @@ with Xrefs; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Disp_Vhdl; +with Elocations; package body Ghdlprint is type Html_Format_Type is (Html_2, Html_Css); @@ -681,6 +682,7 @@ package body Ghdlprint is Len : Natural; begin Flags.Bootstrap := True; + Flags.Flag_Elocations := True; -- Load word library. Libraries.Load_Std_Library; Libraries.Load_Work_Library; @@ -763,7 +765,7 @@ package body Ghdlprint is Lib := Get_Library_Unit (Unit); Location_To_File_Pos - (Get_End_Location (Unit), File_Entry, Lend); + (Elocations.Get_End_Location (Lib), File_Entry, Lend); if Lend < First then raise Internal_Error; end if; diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index de2e383ba..5ce64b299 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -346,14 +346,6 @@ package body Ghdlxml is when Type_Iir_Direction => Put_Field (F, Image_Iir_Direction (Get_Iir_Direction (N, F))); - when Type_Location_Type => - declare - Loc : constant Location_Type := Get_Location_Type (N, F); - begin - if Loc /= No_Location then - Put_Field (F, Image_Location_Type (Loc)); - end if; - end; when Type_Iir_Int32 => Put_Field (F, Strip (Iir_Int32'Image (Get_Iir_Int32 (N, F)))); diff --git a/src/vhdl/Makefile b/src/vhdl/Makefile index 62428107d..3fadbeacc 100644 --- a/src/vhdl/Makefile +++ b/src/vhdl/Makefile @@ -26,8 +26,13 @@ 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 \ python/libghdl/iirs.py python/libghdl/nodes_meta.py \ - python/libghdl/std_names.py python/libghdl/tokens.py + python/libghdl/std_names.py python/libghdl/tokens.py \ + python/libghdl/elocations.py + +ELOCATIONS_FLAGS=--node-file=elocations.ads --field-file=elocations.adb.in \ + --template-file=elocations.adb.in --meta-basename=elocations_meta all: $(GEN_FILES) @@ -46,6 +51,21 @@ nodes_meta.adb: nodes_meta.adb.in $(DEPS) $(PNODES) meta_body > $@ chmod -w $@ +elocations.adb: elocations.adb.in elocations.ads $(DEPS) + $(RM) $@ + $(PNODES) $(ELOCATIONS_FLAGS) body > $@ + chmod -w $@ + +elocations_meta.ads: elocations_meta.ads.in elocations.ads $(DEPS) + $(RM) $@ + $(PNODES) $(ELOCATIONS_FLAGS) meta_specs > $@ + chmod -w $@ + +elocations_meta.adb: elocations_meta.adb.in elocations.ads $(DEPS) + $(RM) $@ + $(PNODES) $(ELOCATIONS_FLAGS) meta_body > $@ + chmod -w $@ + python/libghdl/iirs.py: $(DEPS) $(PNODESPY) $(RM) $@ $(PNODESPY) libghdl-iirs > $@ @@ -66,5 +86,10 @@ python/libghdl/tokens.py: $(PNODESPY) tokens.ads $(PNODESPY) libghdl-tokens > $@ chmod -w $@ +python/libghdl/elocations.py: $(PNODESPY) elocations.ads + $(RM) $@ + $(PNODESPY) $(ELOCATIONS_FLAGS) libghdl-elocs > $@ + chmod -w $@ + clean: $(RM) -f $(GEN_FILES) diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index 69dd0ad16..9af60f01b 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -515,9 +515,6 @@ package body Disp_Tree is when Type_Iir_Direction => Put_Line (Image_Iir_Direction (Get_Iir_Direction (N, F))); - when Type_Location_Type => - Put_Line (Image_Location_Type - (Get_Location_Type (N, F))); when Type_Iir_Int32 => Put_Line (Iir_Int32'Image (Get_Iir_Int32 (N, F))); when Type_Int32 => diff --git a/src/vhdl/elocations.adb.in b/src/vhdl/elocations.adb.in new file mode 100644 index 000000000..c4c8403b0 --- /dev/null +++ b/src/vhdl/elocations.adb.in @@ -0,0 +1,157 @@ +-- 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 +end Elocations; diff --git a/src/vhdl/elocations.ads b/src/vhdl/elocations.ads new file mode 100644 index 000000000..6c671794f --- /dev/null +++ b/src/vhdl/elocations.ads @@ -0,0 +1,647 @@ +-- 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 (None) + -- Iir_Kind_Association_Element_Open (None) + -- Iir_Kind_Association_Element_By_Individual (None) + -- Iir_Kind_Association_Element_Package (None) + -- Iir_Kind_Association_Element_Type (None) + -- Iir_Kind_Association_Element_Subprogram (None) + + -- 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 (L5) + -- + -- Get/Set_Generic_Location (Field4) + -- + -- Get/Set_Port_Location (Field5) + -- + -- Get/Set_Generic_Map_Location (Field3) + -- + -- Get/Set_Port_Map_Location (Field2) + + -- Iir_Kind_Entity_Class (None) + + -- Iir_Kind_Attribute_Specification (None) + + -- Iir_Kind_Attribute_Value (None) + + -- Iir_Kind_Psl_Expression (None) + + -- Iir_Kind_Signature (None) + + -- Iir_Kind_Overload_List (None) + + ------------------- + -- Declarations -- + ------------------- + + -- Iir_Kind_Entity_Declaration (L5) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generic_Location (Field4) + -- + -- Get/Set_Port_Location (Field5) + -- + -- Get/Set_Begin_Location (Field3) + + -- Iir_Kind_Architecture_Body (L3) + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + + -- Iir_Kind_Configuration_Declaration (L2) + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + + -- Iir_Kind_Package_Header (L5) + -- + -- Get/Set_Generic_Location (Field4) + -- + -- 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 (L5) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Generic_Location (Field4) + -- + -- Get/Set_Port_Location (Field5) + + -- Iir_Kind_Object_Alias_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Non_Object_Alias_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- Iir_Kind_Anonymous_Type_Declaration (None) + + -- Iir_Kind_Type_Declaration (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_Is_Location (Field2) + + -- Iir_Kind_Subtype_Declaration (L2) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_Is_Location (Field2) + + -- Iir_Kind_Nature_Declaration (None) + + -- Iir_Kind_Subnature_Declaration (None) + + -- Iir_Kind_Interface_Signal_Declaration (L1) + -- Iir_Kind_Interface_Constant_Declaration (L1) + -- Iir_Kind_Interface_Variable_Declaration (L1) + -- Iir_Kind_Interface_File_Declaration (L1) + -- + -- Get/Set_Start_Location (Field1) + + -- 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 (L3) + -- Iir_Kind_Procedure_Body (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + + -- 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_Start_Location (Field1) + -- + -- 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 (L3) + -- Iir_Kind_Process_Statement (L3) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + + -- 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 (L3) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Begin_Location (Field3) + + -- 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 (None) + + -- Iir_Kind_If_Generate_Else_Clause (None) + + -- Iir_Kind_If_Generate_Statement (None) + + -- 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) + -- + -- Get/Set_Start_Location (Field1) + -- + -- Get/Set_End_Location (Field2) + -- + -- Get/Set_Loop_Location (Field3) + + -- Iir_Kind_While_Loop_Statement (None) + + -- 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 (None) + + -- 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); + + -- General methods. + + -- Field: Field1 + function Get_Start_Location (N : Iir) return Location_Type; + procedure Set_Start_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: Field2 + 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: Field4 + function Get_Generic_Location (N : Iir) return Location_Type; + procedure Set_Generic_Location (N : Iir; Loc : Location_Type); + + -- Field: Field5 + 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); +end Elocations; diff --git a/src/vhdl/elocations_meta.adb.in b/src/vhdl/elocations_meta.adb.in new file mode 100644 index 000000000..279edcfde --- /dev/null +++ b/src/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 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.in b/src/vhdl/elocations_meta.ads.in new file mode 100644 index 000000000..d8595b143 --- /dev/null +++ b/src/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 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/iirs.adb b/src/vhdl/iirs.adb index 8a30242e4..929395b2d 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -203,16 +203,6 @@ package body Iirs is return Iir (P); end Source_Ptr_To_Iir; - function Iir_To_Location_Type (N : Iir) return Location_Type is - begin - return Location_Type (N); - end Iir_To_Location_Type; - - function Location_Type_To_Iir (L : Location_Type) return Iir is - begin - return Iir (L); - end Location_Type_To_Iir; - function Boolean_To_Iir_Delay_Mechanism is new Ada.Unchecked_Conversion (Source => Boolean, Target => Iir_Delay_Mechanism); function Iir_Delay_Mechanism_To_Boolean is new Ada.Unchecked_Conversion @@ -5369,22 +5359,6 @@ package body Iirs is Set_Field4 (Target, Decl); end Set_Protected_Type_Declaration; - function Get_End_Location (Target : Iir) return Location_Type is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (Target)), - "no field End_Location"); - return Iir_To_Location_Type (Get_Field6 (Target)); - end Get_End_Location; - - procedure Set_End_Location (Target : Iir; Loc : Location_Type) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (Target)), - "no field End_Location"); - Set_Field6 (Target, Location_Type_To_Iir (Loc)); - end Set_End_Location; - function Get_Use_Flag (Decl : Iir) return Boolean is begin pragma Assert (Decl /= Null_Iir); diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in index b5f06705e..a13166f76 100644 --- a/src/vhdl/iirs.adb.in +++ b/src/vhdl/iirs.adb.in @@ -203,16 +203,6 @@ package body Iirs is return Iir (P); end Source_Ptr_To_Iir; - function Iir_To_Location_Type (N : Iir) return Location_Type is - begin - return Location_Type (N); - end Iir_To_Location_Type; - - function Location_Type_To_Iir (L : Location_Type) return Iir is - begin - return Iir (L); - end Location_Type_To_Iir; - function Boolean_To_Iir_Delay_Mechanism is new Ada.Unchecked_Conversion (Source => Boolean, Target => Iir_Delay_Mechanism); function Iir_Delay_Mechanism_To_Boolean is new Ada.Unchecked_Conversion diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 95239ffb6..763106c3c 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -233,8 +233,6 @@ package Iirs is -- a package, a package body or a configuration. -- Get/Set_Library_Unit (Field5) -- - -- Get/Set_End_Location (Field6) - -- -- Collision chain for units. -- Get/Set_Hash_Chain (Field7) -- @@ -517,6 +515,12 @@ package Iirs is -- Iir_Kind_Choice_By_Expression (Short) -- (Iir_Kinds_Choice) -- + -- + -- The location of the first alternative is set on: + -- 'when' for case statement, selected assignment and case generate, + -- '(' or ',' for aggregates. + -- The location of the following alternatives is set on '|'. + -- -- Get/Set_Parent (Field0) -- -- For a list of choices, only the first one is associated, the following @@ -1967,6 +1971,8 @@ package Iirs is -- use_clause ::= -- USE selected_name { , selected_name } ; -- + -- Location is on 'USE'. + -- -- Get/Set_Parent (Field0) -- -- Get/Set_Selected_Name (Field1) @@ -2730,6 +2736,8 @@ package Iirs is -- Iir_Kind_Sensitized_Process_Statement (Medium) -- Iir_Kind_Process_Statement (Medium) -- + -- Location is on the label, or 'postponed' or 'process'. + -- -- Get/Set_Parent (Field0) -- -- Get/Set_Declaration_Chain (Field1) @@ -7249,11 +7257,6 @@ package Iirs is function Get_Protected_Type_Declaration (Target : Iir) return Iir; procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir); - -- Location of the 'end' token. - -- Field: Field6 (uc) - function Get_End_Location (Target : Iir) return Location_Type; - procedure Set_End_Location (Target : Iir; Loc : Location_Type); - -- For a declaration: true if the declaration is used somewhere. -- Field: Flag6 function Get_Use_Flag (Decl : Iir) return Boolean; diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index aa56a1442..4a32af931 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -315,7 +315,6 @@ package body Nodes_Meta is Field_Simple_Name_Subtype => Type_Iir, Field_Protected_Type_Body => Type_Iir, Field_Protected_Type_Declaration => Type_Iir, - Field_End_Location => Type_Location_Type, Field_Use_Flag => Type_Boolean, Field_End_Has_Reserved_Id => Type_Boolean, Field_End_Has_Identifier => Type_Boolean, @@ -945,8 +944,6 @@ package body Nodes_Meta is return "protected_type_body"; when Field_Protected_Type_Declaration => return "protected_type_declaration"; - when Field_End_Location => - return "end_location"; when Field_Use_Flag => return "use_flag"; when Field_End_Has_Reserved_Id => @@ -2141,8 +2138,6 @@ package body Nodes_Meta is return Attr_Forward_Ref; when Field_Protected_Type_Declaration => return Attr_Ref; - when Field_End_Location => - return Attr_None; when Field_Use_Flag => return Attr_None; when Field_End_Has_Reserved_Id => @@ -2229,7 +2224,6 @@ package body Nodes_Meta is Field_Design_Unit_Source_Col, Field_Identifier, Field_Date, - Field_End_Location, Field_Elab_Flag, Field_Configuration_Mark_Flag, Field_Configuration_Done_Flag, @@ -4382,271 +4376,271 @@ package body Nodes_Meta is Iir_Kind_Unused => -1, Iir_Kind_Error => 7, Iir_Kind_Design_File => 17, - Iir_Kind_Design_Unit => 34, - Iir_Kind_Library_Clause => 39, - Iir_Kind_Use_Clause => 43, - Iir_Kind_Context_Reference => 47, - Iir_Kind_Integer_Literal => 51, - Iir_Kind_Floating_Point_Literal => 55, - Iir_Kind_Null_Literal => 57, - Iir_Kind_String_Literal8 => 67, - Iir_Kind_Physical_Int_Literal => 73, - Iir_Kind_Physical_Fp_Literal => 79, - Iir_Kind_Simple_Aggregate => 84, - Iir_Kind_Overflow_Literal => 87, - Iir_Kind_Unaffected_Waveform => 88, - Iir_Kind_Waveform_Element => 91, - Iir_Kind_Conditional_Waveform => 95, - Iir_Kind_Conditional_Expression => 99, - Iir_Kind_Association_Element_By_Expression => 107, - Iir_Kind_Association_Element_By_Individual => 116, - Iir_Kind_Association_Element_Open => 122, - Iir_Kind_Association_Element_Package => 128, - Iir_Kind_Association_Element_Type => 136, - Iir_Kind_Association_Element_Subprogram => 142, - Iir_Kind_Choice_By_Range => 149, - Iir_Kind_Choice_By_Expression => 156, - Iir_Kind_Choice_By_Others => 161, - Iir_Kind_Choice_By_None => 166, - Iir_Kind_Choice_By_Name => 172, - Iir_Kind_Entity_Aspect_Entity => 174, - Iir_Kind_Entity_Aspect_Configuration => 175, - Iir_Kind_Entity_Aspect_Open => 175, - Iir_Kind_Block_Configuration => 181, - Iir_Kind_Block_Header => 185, - Iir_Kind_Component_Configuration => 192, - Iir_Kind_Binding_Indication => 196, - Iir_Kind_Entity_Class => 198, - Iir_Kind_Attribute_Value => 206, - Iir_Kind_Signature => 209, - Iir_Kind_Aggregate_Info => 216, - Iir_Kind_Procedure_Call => 220, - Iir_Kind_Record_Element_Constraint => 227, - Iir_Kind_Array_Element_Resolution => 229, - Iir_Kind_Record_Resolution => 230, - Iir_Kind_Record_Element_Resolution => 233, - Iir_Kind_Attribute_Specification => 241, - Iir_Kind_Disconnection_Specification => 247, - Iir_Kind_Configuration_Specification => 253, - Iir_Kind_Access_Type_Definition => 261, - Iir_Kind_Incomplete_Type_Definition => 269, - Iir_Kind_Interface_Type_Definition => 276, - Iir_Kind_File_Type_Definition => 283, - Iir_Kind_Protected_Type_Declaration => 292, - Iir_Kind_Record_Type_Definition => 302, - Iir_Kind_Array_Type_Definition => 314, - Iir_Kind_Array_Subtype_Definition => 329, - Iir_Kind_Record_Subtype_Definition => 340, - Iir_Kind_Access_Subtype_Definition => 348, - Iir_Kind_Physical_Subtype_Definition => 358, - Iir_Kind_Floating_Subtype_Definition => 369, - Iir_Kind_Integer_Subtype_Definition => 379, - Iir_Kind_Enumeration_Subtype_Definition => 389, - Iir_Kind_Enumeration_Type_Definition => 400, - Iir_Kind_Integer_Type_Definition => 408, - Iir_Kind_Floating_Type_Definition => 416, - Iir_Kind_Physical_Type_Definition => 427, - Iir_Kind_Range_Expression => 435, - Iir_Kind_Protected_Type_Body => 442, - Iir_Kind_Wildcard_Type_Definition => 447, - Iir_Kind_Subtype_Definition => 452, - Iir_Kind_Scalar_Nature_Definition => 456, - Iir_Kind_Overload_List => 457, - Iir_Kind_Type_Declaration => 464, - Iir_Kind_Anonymous_Type_Declaration => 470, - Iir_Kind_Subtype_Declaration => 477, - Iir_Kind_Nature_Declaration => 483, - Iir_Kind_Subnature_Declaration => 489, - Iir_Kind_Package_Declaration => 503, - Iir_Kind_Package_Instantiation_Declaration => 516, - Iir_Kind_Package_Body => 524, - Iir_Kind_Configuration_Declaration => 533, - Iir_Kind_Entity_Declaration => 545, - Iir_Kind_Architecture_Body => 557, - Iir_Kind_Context_Declaration => 563, - Iir_Kind_Package_Header => 565, - Iir_Kind_Unit_Declaration => 573, - Iir_Kind_Library_Declaration => 580, - Iir_Kind_Component_Declaration => 590, - Iir_Kind_Attribute_Declaration => 597, - Iir_Kind_Group_Template_Declaration => 603, - Iir_Kind_Group_Declaration => 610, - Iir_Kind_Element_Declaration => 618, - Iir_Kind_Non_Object_Alias_Declaration => 626, - Iir_Kind_Psl_Declaration => 634, - Iir_Kind_Psl_Endpoint_Declaration => 648, - Iir_Kind_Terminal_Declaration => 654, - Iir_Kind_Free_Quantity_Declaration => 663, - Iir_Kind_Across_Quantity_Declaration => 675, - Iir_Kind_Through_Quantity_Declaration => 687, - Iir_Kind_Enumeration_Literal => 698, - Iir_Kind_Function_Declaration => 723, - Iir_Kind_Procedure_Declaration => 747, - Iir_Kind_Function_Body => 757, - Iir_Kind_Procedure_Body => 768, - Iir_Kind_Object_Alias_Declaration => 779, - Iir_Kind_File_Declaration => 793, - Iir_Kind_Guard_Signal_Declaration => 806, - Iir_Kind_Signal_Declaration => 823, - Iir_Kind_Variable_Declaration => 836, - Iir_Kind_Constant_Declaration => 850, - Iir_Kind_Iterator_Declaration => 861, - Iir_Kind_Interface_Constant_Declaration => 877, - Iir_Kind_Interface_Variable_Declaration => 893, - Iir_Kind_Interface_Signal_Declaration => 914, - Iir_Kind_Interface_File_Declaration => 930, - Iir_Kind_Interface_Type_Declaration => 940, - Iir_Kind_Interface_Package_Declaration => 951, - Iir_Kind_Interface_Function_Declaration => 968, - Iir_Kind_Interface_Procedure_Declaration => 981, - Iir_Kind_Signal_Attribute_Declaration => 984, - Iir_Kind_Identity_Operator => 988, - Iir_Kind_Negation_Operator => 992, - Iir_Kind_Absolute_Operator => 996, - Iir_Kind_Not_Operator => 1000, - Iir_Kind_Condition_Operator => 1004, - Iir_Kind_Reduction_And_Operator => 1008, - Iir_Kind_Reduction_Or_Operator => 1012, - Iir_Kind_Reduction_Nand_Operator => 1016, - Iir_Kind_Reduction_Nor_Operator => 1020, - Iir_Kind_Reduction_Xor_Operator => 1024, - Iir_Kind_Reduction_Xnor_Operator => 1028, - Iir_Kind_And_Operator => 1033, - Iir_Kind_Or_Operator => 1038, - Iir_Kind_Nand_Operator => 1043, - Iir_Kind_Nor_Operator => 1048, - Iir_Kind_Xor_Operator => 1053, - Iir_Kind_Xnor_Operator => 1058, - Iir_Kind_Equality_Operator => 1063, - Iir_Kind_Inequality_Operator => 1068, - Iir_Kind_Less_Than_Operator => 1073, - Iir_Kind_Less_Than_Or_Equal_Operator => 1078, - Iir_Kind_Greater_Than_Operator => 1083, - Iir_Kind_Greater_Than_Or_Equal_Operator => 1088, - Iir_Kind_Match_Equality_Operator => 1093, - Iir_Kind_Match_Inequality_Operator => 1098, - Iir_Kind_Match_Less_Than_Operator => 1103, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1108, - Iir_Kind_Match_Greater_Than_Operator => 1113, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1118, - Iir_Kind_Sll_Operator => 1123, - Iir_Kind_Sla_Operator => 1128, - Iir_Kind_Srl_Operator => 1133, - Iir_Kind_Sra_Operator => 1138, - Iir_Kind_Rol_Operator => 1143, - Iir_Kind_Ror_Operator => 1148, - Iir_Kind_Addition_Operator => 1153, - Iir_Kind_Substraction_Operator => 1158, - Iir_Kind_Concatenation_Operator => 1163, - Iir_Kind_Multiplication_Operator => 1168, - Iir_Kind_Division_Operator => 1173, - Iir_Kind_Modulus_Operator => 1178, - Iir_Kind_Remainder_Operator => 1183, - Iir_Kind_Exponentiation_Operator => 1188, - Iir_Kind_Function_Call => 1196, - Iir_Kind_Aggregate => 1203, - Iir_Kind_Parenthesis_Expression => 1206, - Iir_Kind_Qualified_Expression => 1210, - Iir_Kind_Type_Conversion => 1215, - Iir_Kind_Allocator_By_Expression => 1219, - Iir_Kind_Allocator_By_Subtype => 1224, - Iir_Kind_Selected_Element => 1231, - Iir_Kind_Dereference => 1236, - Iir_Kind_Implicit_Dereference => 1241, - Iir_Kind_Slice_Name => 1248, - Iir_Kind_Indexed_Name => 1254, - Iir_Kind_Psl_Expression => 1256, - Iir_Kind_Sensitized_Process_Statement => 1277, - Iir_Kind_Process_Statement => 1297, - Iir_Kind_Concurrent_Simple_Signal_Assignment => 1309, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1321, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1334, - Iir_Kind_Concurrent_Assertion_Statement => 1342, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1349, - Iir_Kind_Psl_Assert_Statement => 1362, - Iir_Kind_Psl_Cover_Statement => 1375, - Iir_Kind_Block_Statement => 1388, - Iir_Kind_If_Generate_Statement => 1399, - Iir_Kind_Case_Generate_Statement => 1408, - Iir_Kind_For_Generate_Statement => 1417, - Iir_Kind_Component_Instantiation_Statement => 1427, - Iir_Kind_Psl_Default_Clock => 1431, - Iir_Kind_Simple_Simultaneous_Statement => 1438, - Iir_Kind_Generate_Statement_Body => 1449, - Iir_Kind_If_Generate_Else_Clause => 1455, - Iir_Kind_Simple_Signal_Assignment_Statement => 1465, - Iir_Kind_Conditional_Signal_Assignment_Statement => 1475, - Iir_Kind_Selected_Waveform_Assignment_Statement => 1486, - Iir_Kind_Null_Statement => 1490, - Iir_Kind_Assertion_Statement => 1497, - Iir_Kind_Report_Statement => 1503, - Iir_Kind_Wait_Statement => 1511, - Iir_Kind_Variable_Assignment_Statement => 1518, - Iir_Kind_Conditional_Variable_Assignment_Statement => 1525, - Iir_Kind_Return_Statement => 1531, - Iir_Kind_For_Loop_Statement => 1540, - Iir_Kind_While_Loop_Statement => 1549, - Iir_Kind_Next_Statement => 1556, - Iir_Kind_Exit_Statement => 1563, - Iir_Kind_Case_Statement => 1571, - Iir_Kind_Procedure_Call_Statement => 1577, - Iir_Kind_If_Statement => 1587, - Iir_Kind_Elsif => 1593, - Iir_Kind_Character_Literal => 1601, - Iir_Kind_Simple_Name => 1609, - Iir_Kind_Selected_Name => 1618, - Iir_Kind_Operator_Symbol => 1624, - Iir_Kind_Reference_Name => 1627, - Iir_Kind_Selected_By_All_Name => 1633, - Iir_Kind_Parenthesis_Name => 1638, - Iir_Kind_External_Constant_Name => 1646, - Iir_Kind_External_Signal_Name => 1654, - Iir_Kind_External_Variable_Name => 1662, - Iir_Kind_Package_Pathname => 1666, - Iir_Kind_Absolute_Pathname => 1667, - Iir_Kind_Relative_Pathname => 1668, - Iir_Kind_Pathname_Element => 1673, - Iir_Kind_Base_Attribute => 1675, - Iir_Kind_Subtype_Attribute => 1680, - Iir_Kind_Element_Attribute => 1685, - Iir_Kind_Left_Type_Attribute => 1690, - Iir_Kind_Right_Type_Attribute => 1695, - Iir_Kind_High_Type_Attribute => 1700, - Iir_Kind_Low_Type_Attribute => 1705, - Iir_Kind_Ascending_Type_Attribute => 1710, - Iir_Kind_Image_Attribute => 1716, - Iir_Kind_Value_Attribute => 1722, - Iir_Kind_Pos_Attribute => 1728, - Iir_Kind_Val_Attribute => 1734, - Iir_Kind_Succ_Attribute => 1740, - Iir_Kind_Pred_Attribute => 1746, - Iir_Kind_Leftof_Attribute => 1752, - Iir_Kind_Rightof_Attribute => 1758, - Iir_Kind_Delayed_Attribute => 1767, - Iir_Kind_Stable_Attribute => 1776, - Iir_Kind_Quiet_Attribute => 1785, - Iir_Kind_Transaction_Attribute => 1794, - Iir_Kind_Event_Attribute => 1798, - Iir_Kind_Active_Attribute => 1802, - Iir_Kind_Last_Event_Attribute => 1806, - Iir_Kind_Last_Active_Attribute => 1810, - Iir_Kind_Last_Value_Attribute => 1814, - Iir_Kind_Driving_Attribute => 1818, - Iir_Kind_Driving_Value_Attribute => 1822, - Iir_Kind_Behavior_Attribute => 1822, - Iir_Kind_Structure_Attribute => 1822, - Iir_Kind_Simple_Name_Attribute => 1829, - Iir_Kind_Instance_Name_Attribute => 1834, - Iir_Kind_Path_Name_Attribute => 1839, - Iir_Kind_Left_Array_Attribute => 1846, - Iir_Kind_Right_Array_Attribute => 1853, - Iir_Kind_High_Array_Attribute => 1860, - Iir_Kind_Low_Array_Attribute => 1867, - Iir_Kind_Length_Array_Attribute => 1874, - Iir_Kind_Ascending_Array_Attribute => 1881, - Iir_Kind_Range_Array_Attribute => 1888, - Iir_Kind_Reverse_Range_Array_Attribute => 1895, - Iir_Kind_Attribute_Name => 1904 + Iir_Kind_Design_Unit => 33, + Iir_Kind_Library_Clause => 38, + Iir_Kind_Use_Clause => 42, + Iir_Kind_Context_Reference => 46, + Iir_Kind_Integer_Literal => 50, + Iir_Kind_Floating_Point_Literal => 54, + Iir_Kind_Null_Literal => 56, + Iir_Kind_String_Literal8 => 66, + Iir_Kind_Physical_Int_Literal => 72, + Iir_Kind_Physical_Fp_Literal => 78, + Iir_Kind_Simple_Aggregate => 83, + Iir_Kind_Overflow_Literal => 86, + Iir_Kind_Unaffected_Waveform => 87, + Iir_Kind_Waveform_Element => 90, + Iir_Kind_Conditional_Waveform => 94, + Iir_Kind_Conditional_Expression => 98, + Iir_Kind_Association_Element_By_Expression => 106, + Iir_Kind_Association_Element_By_Individual => 115, + Iir_Kind_Association_Element_Open => 121, + Iir_Kind_Association_Element_Package => 127, + Iir_Kind_Association_Element_Type => 135, + Iir_Kind_Association_Element_Subprogram => 141, + Iir_Kind_Choice_By_Range => 148, + Iir_Kind_Choice_By_Expression => 155, + Iir_Kind_Choice_By_Others => 160, + Iir_Kind_Choice_By_None => 165, + Iir_Kind_Choice_By_Name => 171, + Iir_Kind_Entity_Aspect_Entity => 173, + Iir_Kind_Entity_Aspect_Configuration => 174, + Iir_Kind_Entity_Aspect_Open => 174, + Iir_Kind_Block_Configuration => 180, + Iir_Kind_Block_Header => 184, + Iir_Kind_Component_Configuration => 191, + Iir_Kind_Binding_Indication => 195, + Iir_Kind_Entity_Class => 197, + Iir_Kind_Attribute_Value => 205, + Iir_Kind_Signature => 208, + Iir_Kind_Aggregate_Info => 215, + Iir_Kind_Procedure_Call => 219, + Iir_Kind_Record_Element_Constraint => 226, + Iir_Kind_Array_Element_Resolution => 228, + Iir_Kind_Record_Resolution => 229, + Iir_Kind_Record_Element_Resolution => 232, + Iir_Kind_Attribute_Specification => 240, + Iir_Kind_Disconnection_Specification => 246, + Iir_Kind_Configuration_Specification => 252, + Iir_Kind_Access_Type_Definition => 260, + Iir_Kind_Incomplete_Type_Definition => 268, + Iir_Kind_Interface_Type_Definition => 275, + Iir_Kind_File_Type_Definition => 282, + Iir_Kind_Protected_Type_Declaration => 291, + Iir_Kind_Record_Type_Definition => 301, + Iir_Kind_Array_Type_Definition => 313, + Iir_Kind_Array_Subtype_Definition => 328, + Iir_Kind_Record_Subtype_Definition => 339, + Iir_Kind_Access_Subtype_Definition => 347, + Iir_Kind_Physical_Subtype_Definition => 357, + Iir_Kind_Floating_Subtype_Definition => 368, + Iir_Kind_Integer_Subtype_Definition => 378, + Iir_Kind_Enumeration_Subtype_Definition => 388, + Iir_Kind_Enumeration_Type_Definition => 399, + Iir_Kind_Integer_Type_Definition => 407, + Iir_Kind_Floating_Type_Definition => 415, + Iir_Kind_Physical_Type_Definition => 426, + Iir_Kind_Range_Expression => 434, + Iir_Kind_Protected_Type_Body => 441, + Iir_Kind_Wildcard_Type_Definition => 446, + Iir_Kind_Subtype_Definition => 451, + Iir_Kind_Scalar_Nature_Definition => 455, + Iir_Kind_Overload_List => 456, + Iir_Kind_Type_Declaration => 463, + Iir_Kind_Anonymous_Type_Declaration => 469, + Iir_Kind_Subtype_Declaration => 476, + Iir_Kind_Nature_Declaration => 482, + Iir_Kind_Subnature_Declaration => 488, + Iir_Kind_Package_Declaration => 502, + Iir_Kind_Package_Instantiation_Declaration => 515, + Iir_Kind_Package_Body => 523, + Iir_Kind_Configuration_Declaration => 532, + Iir_Kind_Entity_Declaration => 544, + Iir_Kind_Architecture_Body => 556, + Iir_Kind_Context_Declaration => 562, + Iir_Kind_Package_Header => 564, + Iir_Kind_Unit_Declaration => 572, + Iir_Kind_Library_Declaration => 579, + Iir_Kind_Component_Declaration => 589, + Iir_Kind_Attribute_Declaration => 596, + Iir_Kind_Group_Template_Declaration => 602, + Iir_Kind_Group_Declaration => 609, + Iir_Kind_Element_Declaration => 617, + Iir_Kind_Non_Object_Alias_Declaration => 625, + Iir_Kind_Psl_Declaration => 633, + Iir_Kind_Psl_Endpoint_Declaration => 647, + Iir_Kind_Terminal_Declaration => 653, + Iir_Kind_Free_Quantity_Declaration => 662, + Iir_Kind_Across_Quantity_Declaration => 674, + Iir_Kind_Through_Quantity_Declaration => 686, + Iir_Kind_Enumeration_Literal => 697, + Iir_Kind_Function_Declaration => 722, + Iir_Kind_Procedure_Declaration => 746, + Iir_Kind_Function_Body => 756, + Iir_Kind_Procedure_Body => 767, + Iir_Kind_Object_Alias_Declaration => 778, + Iir_Kind_File_Declaration => 792, + Iir_Kind_Guard_Signal_Declaration => 805, + Iir_Kind_Signal_Declaration => 822, + Iir_Kind_Variable_Declaration => 835, + Iir_Kind_Constant_Declaration => 849, + Iir_Kind_Iterator_Declaration => 860, + Iir_Kind_Interface_Constant_Declaration => 876, + Iir_Kind_Interface_Variable_Declaration => 892, + Iir_Kind_Interface_Signal_Declaration => 913, + Iir_Kind_Interface_File_Declaration => 929, + Iir_Kind_Interface_Type_Declaration => 939, + Iir_Kind_Interface_Package_Declaration => 950, + Iir_Kind_Interface_Function_Declaration => 967, + Iir_Kind_Interface_Procedure_Declaration => 980, + Iir_Kind_Signal_Attribute_Declaration => 983, + Iir_Kind_Identity_Operator => 987, + Iir_Kind_Negation_Operator => 991, + Iir_Kind_Absolute_Operator => 995, + Iir_Kind_Not_Operator => 999, + Iir_Kind_Condition_Operator => 1003, + Iir_Kind_Reduction_And_Operator => 1007, + Iir_Kind_Reduction_Or_Operator => 1011, + Iir_Kind_Reduction_Nand_Operator => 1015, + Iir_Kind_Reduction_Nor_Operator => 1019, + Iir_Kind_Reduction_Xor_Operator => 1023, + Iir_Kind_Reduction_Xnor_Operator => 1027, + Iir_Kind_And_Operator => 1032, + Iir_Kind_Or_Operator => 1037, + Iir_Kind_Nand_Operator => 1042, + Iir_Kind_Nor_Operator => 1047, + Iir_Kind_Xor_Operator => 1052, + Iir_Kind_Xnor_Operator => 1057, + Iir_Kind_Equality_Operator => 1062, + Iir_Kind_Inequality_Operator => 1067, + Iir_Kind_Less_Than_Operator => 1072, + Iir_Kind_Less_Than_Or_Equal_Operator => 1077, + Iir_Kind_Greater_Than_Operator => 1082, + Iir_Kind_Greater_Than_Or_Equal_Operator => 1087, + Iir_Kind_Match_Equality_Operator => 1092, + Iir_Kind_Match_Inequality_Operator => 1097, + Iir_Kind_Match_Less_Than_Operator => 1102, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1107, + Iir_Kind_Match_Greater_Than_Operator => 1112, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1117, + Iir_Kind_Sll_Operator => 1122, + Iir_Kind_Sla_Operator => 1127, + Iir_Kind_Srl_Operator => 1132, + Iir_Kind_Sra_Operator => 1137, + Iir_Kind_Rol_Operator => 1142, + Iir_Kind_Ror_Operator => 1147, + Iir_Kind_Addition_Operator => 1152, + Iir_Kind_Substraction_Operator => 1157, + Iir_Kind_Concatenation_Operator => 1162, + Iir_Kind_Multiplication_Operator => 1167, + Iir_Kind_Division_Operator => 1172, + Iir_Kind_Modulus_Operator => 1177, + Iir_Kind_Remainder_Operator => 1182, + Iir_Kind_Exponentiation_Operator => 1187, + Iir_Kind_Function_Call => 1195, + Iir_Kind_Aggregate => 1202, + Iir_Kind_Parenthesis_Expression => 1205, + Iir_Kind_Qualified_Expression => 1209, + Iir_Kind_Type_Conversion => 1214, + Iir_Kind_Allocator_By_Expression => 1218, + Iir_Kind_Allocator_By_Subtype => 1223, + Iir_Kind_Selected_Element => 1230, + Iir_Kind_Dereference => 1235, + Iir_Kind_Implicit_Dereference => 1240, + Iir_Kind_Slice_Name => 1247, + Iir_Kind_Indexed_Name => 1253, + Iir_Kind_Psl_Expression => 1255, + Iir_Kind_Sensitized_Process_Statement => 1276, + Iir_Kind_Process_Statement => 1296, + Iir_Kind_Concurrent_Simple_Signal_Assignment => 1308, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1320, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1333, + Iir_Kind_Concurrent_Assertion_Statement => 1341, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1348, + Iir_Kind_Psl_Assert_Statement => 1361, + Iir_Kind_Psl_Cover_Statement => 1374, + Iir_Kind_Block_Statement => 1387, + Iir_Kind_If_Generate_Statement => 1398, + Iir_Kind_Case_Generate_Statement => 1407, + Iir_Kind_For_Generate_Statement => 1416, + Iir_Kind_Component_Instantiation_Statement => 1426, + Iir_Kind_Psl_Default_Clock => 1430, + Iir_Kind_Simple_Simultaneous_Statement => 1437, + Iir_Kind_Generate_Statement_Body => 1448, + Iir_Kind_If_Generate_Else_Clause => 1454, + Iir_Kind_Simple_Signal_Assignment_Statement => 1464, + Iir_Kind_Conditional_Signal_Assignment_Statement => 1474, + Iir_Kind_Selected_Waveform_Assignment_Statement => 1485, + Iir_Kind_Null_Statement => 1489, + Iir_Kind_Assertion_Statement => 1496, + Iir_Kind_Report_Statement => 1502, + Iir_Kind_Wait_Statement => 1510, + Iir_Kind_Variable_Assignment_Statement => 1517, + Iir_Kind_Conditional_Variable_Assignment_Statement => 1524, + Iir_Kind_Return_Statement => 1530, + Iir_Kind_For_Loop_Statement => 1539, + Iir_Kind_While_Loop_Statement => 1548, + Iir_Kind_Next_Statement => 1555, + Iir_Kind_Exit_Statement => 1562, + Iir_Kind_Case_Statement => 1570, + Iir_Kind_Procedure_Call_Statement => 1576, + Iir_Kind_If_Statement => 1586, + Iir_Kind_Elsif => 1592, + Iir_Kind_Character_Literal => 1600, + Iir_Kind_Simple_Name => 1608, + Iir_Kind_Selected_Name => 1617, + Iir_Kind_Operator_Symbol => 1623, + Iir_Kind_Reference_Name => 1626, + Iir_Kind_Selected_By_All_Name => 1632, + Iir_Kind_Parenthesis_Name => 1637, + Iir_Kind_External_Constant_Name => 1645, + Iir_Kind_External_Signal_Name => 1653, + Iir_Kind_External_Variable_Name => 1661, + Iir_Kind_Package_Pathname => 1665, + Iir_Kind_Absolute_Pathname => 1666, + Iir_Kind_Relative_Pathname => 1667, + Iir_Kind_Pathname_Element => 1672, + Iir_Kind_Base_Attribute => 1674, + Iir_Kind_Subtype_Attribute => 1679, + Iir_Kind_Element_Attribute => 1684, + Iir_Kind_Left_Type_Attribute => 1689, + Iir_Kind_Right_Type_Attribute => 1694, + Iir_Kind_High_Type_Attribute => 1699, + Iir_Kind_Low_Type_Attribute => 1704, + Iir_Kind_Ascending_Type_Attribute => 1709, + Iir_Kind_Image_Attribute => 1715, + Iir_Kind_Value_Attribute => 1721, + Iir_Kind_Pos_Attribute => 1727, + Iir_Kind_Val_Attribute => 1733, + Iir_Kind_Succ_Attribute => 1739, + Iir_Kind_Pred_Attribute => 1745, + Iir_Kind_Leftof_Attribute => 1751, + Iir_Kind_Rightof_Attribute => 1757, + Iir_Kind_Delayed_Attribute => 1766, + Iir_Kind_Stable_Attribute => 1775, + Iir_Kind_Quiet_Attribute => 1784, + Iir_Kind_Transaction_Attribute => 1793, + Iir_Kind_Event_Attribute => 1797, + Iir_Kind_Active_Attribute => 1801, + Iir_Kind_Last_Event_Attribute => 1805, + Iir_Kind_Last_Active_Attribute => 1809, + Iir_Kind_Last_Value_Attribute => 1813, + Iir_Kind_Driving_Attribute => 1817, + Iir_Kind_Driving_Value_Attribute => 1821, + Iir_Kind_Behavior_Attribute => 1821, + Iir_Kind_Structure_Attribute => 1821, + Iir_Kind_Simple_Name_Attribute => 1828, + Iir_Kind_Instance_Name_Attribute => 1833, + Iir_Kind_Path_Name_Attribute => 1838, + Iir_Kind_Left_Array_Attribute => 1845, + Iir_Kind_Right_Array_Attribute => 1852, + Iir_Kind_High_Array_Attribute => 1859, + Iir_Kind_Low_Array_Attribute => 1866, + Iir_Kind_Length_Array_Attribute => 1873, + Iir_Kind_Ascending_Array_Attribute => 1880, + Iir_Kind_Range_Array_Attribute => 1887, + Iir_Kind_Reverse_Range_Array_Attribute => 1894, + Iir_Kind_Attribute_Name => 1903 ); function Get_Fields_First (K : Iir_Kind) return Fields_Index is @@ -6284,30 +6278,6 @@ package body Nodes_Meta is end case; end Set_Int32; - 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_End_Location => - return Get_End_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_End_Location => - Set_End_Location (N, V); - when others => - raise Internal_Error; - end case; - end Set_Location_Type; - function Get_Name_Id (N : Iir; F : Fields_Enum) return Name_Id is begin @@ -10244,11 +10214,6 @@ package body Nodes_Meta is return K = Iir_Kind_Protected_Type_Body; end Has_Protected_Type_Declaration; - function Has_End_Location (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_End_Location; - function Has_Use_Flag (K : Iir_Kind) return Boolean is begin case K is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index f8f91d2c0..e749dc670 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -44,7 +44,6 @@ package Nodes_Meta is Type_Iir_Signal_Kind, Type_Iir_Staticness, Type_Int32, - Type_Location_Type, Type_Name_Id, Type_Number_Base_Type, Type_PSL_NFA, @@ -355,7 +354,6 @@ package Nodes_Meta is Field_Simple_Name_Subtype, Field_Protected_Type_Body, Field_Protected_Type_Declaration, - Field_End_Location, Field_Use_Flag, Field_End_Has_Reserved_Id, Field_End_Has_Identifier, @@ -529,11 +527,6 @@ package Nodes_Meta is procedure Set_Int32 (N : Iir; F : Fields_Enum; V: Int32); - 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 Get_Name_Id (N : Iir; F : Fields_Enum) return Name_Id; procedure Set_Name_Id @@ -881,7 +874,6 @@ package Nodes_Meta is function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean; function Has_Protected_Type_Body (K : Iir_Kind) return Boolean; function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean; - function Has_End_Location (K : Iir_Kind) return Boolean; function Has_Use_Flag (K : Iir_Kind) return Boolean; function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean; function Has_End_Has_Identifier (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 97ab0060c..1092cc490 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -26,6 +26,7 @@ with Parse_Psl; with Name_Table; with Str_Table; with Xrefs; +with Elocations; use Elocations; -- Recursive descendant parser. -- Each subprogram (should) parse one production rules. @@ -81,13 +82,6 @@ package body Parse is Set_Location (Node, Get_Token_Location); end Set_Location; - procedure Set_End_Location (Node : Iir) is - begin - if Get_Kind (Node) = Iir_Kind_Design_Unit then - Set_End_Location (Node, Get_Token_Location); - end if; - end Set_End_Location; - procedure Unexpected (Where: String) is begin Error_Msg_Parse @@ -303,7 +297,7 @@ package body Parse is raise Internal_Error; end case; - -- Skip TO or DOWNTO. + -- Skip 'to' or 'downto'. Scan; Set_Right_Limit_Expr (Res, Parse_Simple_Expression); @@ -858,7 +852,7 @@ package body Parse is Set_Location (Res); Last := Res; - -- Skip '@' + -- Skip '@'. Scan; if Current_Token /= Tok_Identifier then @@ -866,14 +860,14 @@ package body Parse is else Set_Identifier (Res, Current_Identifier); - -- Skip ident + -- Skip identifier. Scan; end if; if Current_Token /= Tok_Dot then Error_Msg_Parse ("'.' expected after library name"); else - -- Skip '.' + -- Skip '.'. Scan; end if; @@ -882,7 +876,7 @@ package body Parse is Set_Location (Res); Last := Res; - -- Skip '.' + -- Skip '.'. Scan; when Tok_Caret => @@ -891,13 +885,13 @@ package body Parse is El := Create_Iir (Iir_Kind_Relative_Pathname); Set_Location (El); - -- Skip '^' + -- Skip '^'. Scan; if Current_Token /= Tok_Dot then Error_Msg_Parse ("'.' expected after '^'"); else - -- Skip '.' + -- Skip '.'. Scan; end if; @@ -937,12 +931,12 @@ package body Parse is end if; Last := El; - -- Skip identifier + -- Skip identifier. Scan; exit when Current_Token /= Tok_Dot; - -- Skip '.' + -- Skip '.'. Scan; end loop; @@ -974,21 +968,21 @@ package body Parse is begin Loc := Get_Token_Location; - -- Skip '<<' + -- Skip '<<'. Scan; case Current_Token is when Tok_Constant => Kind := Iir_Kind_External_Constant_Name; - -- Skip 'constant' + -- Skip 'constant'. Scan; when Tok_Signal => Kind := Iir_Kind_External_Signal_Name; - -- Skip 'signal' + -- Skip 'signal'. Scan; when Tok_Variable => Kind := Iir_Kind_External_Variable_Name; - -- Skip 'variable' + -- Skip 'variable'. Scan; when others => Error_Msg_Parse @@ -1395,19 +1389,19 @@ package body Parse is begin Inter := Create_Iir (Iir_Kind_Interface_Package_Declaration); - -- Skip 'package' + -- Skip 'package'. Scan_Expect (Tok_Identifier, "an identifier is expected after ""package"""); Set_Identifier (Inter, Current_Identifier); Set_Location (Inter); - -- Skip identifier + -- Skip identifier. Scan_Expect (Tok_Is); - -- Skip 'is' + -- Skip 'is'. Scan_Expect (Tok_New); - -- Skip 'new' + -- Skip 'new'. Scan; Set_Uninstantiated_Package_Name (Inter, Parse_Name (False)); @@ -1810,12 +1804,22 @@ package body Parse is if Has_Port then Error_Msg_Parse ("generic clause must precede port clause"); end if; + + if Flag_Elocations then + Set_Generic_Location (Parent, Get_Token_Location); + end if; + Has_Generic := True; Parse_Generic_Clause (Parent); elsif Current_Token = Tok_Port then if Has_Port then Error_Msg_Parse ("at most one port clause is allowed"); end if; + + if Flag_Elocations then + Set_Port_Location (Parent, Get_Token_Location); + end if; + Has_Port := True; Parse_Port_Clause (Parent); else @@ -2375,7 +2379,7 @@ package body Parse is Error_Msg_Parse ("'is' expected here"); -- Act as if IS token was forgotten. else - -- Eat IS token. + -- Skip 'is'. Scan; end if; @@ -2823,7 +2827,7 @@ package body Parse is Error_Msg_Parse ("'is' expected here"); -- Act as if IS token was forgotten. else - -- Eat IS token. + -- Skip 'is'. Scan; end if; @@ -3291,7 +3295,7 @@ package body Parse is Set_Has_Identifier_List (Object, True); end loop; - -- Eat ':' + -- Skip ':'. Scan; Object_Type := Parse_Subtype_Indication; @@ -3399,25 +3403,41 @@ package body Parse is -- [ LOCAL_generic_clause ] -- [ LOCAL_port_clause ] -- END COMPONENT [ COMPONENT_simple_name ] ; - function Parse_Component_Declaration - return Iir_Component_Declaration + function Parse_Component_Declaration return Iir_Component_Declaration is - Component: Iir_Component_Declaration; + Component : Iir_Component_Declaration; begin Component := Create_Iir (Iir_Kind_Component_Declaration); + if Flag_Elocations then + Create_Elocations (Component); + Set_Start_Location (Component, Get_Token_Location); + end if; + + -- Eat 'component'. Scan_Expect (Tok_Identifier, "an identifier is expected after 'component'"); + Set_Identifier (Component, Current_Identifier); Set_Location (Component); + + -- Eat identifier. Scan; + if Current_Token = Tok_Is then if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("""is"" keyword is not allowed here by vhdl 87"); end if; Set_Has_Is (Component, True); + + -- Eat 'is'. Scan; end if; Parse_Generic_Port_Clauses (Component); + + if Flag_Elocations then + Set_End_Location (Component, Get_Token_Location); + end if; + Check_End_Name (Tok_Component, Component); return Component; end Parse_Component_Declaration; @@ -3425,7 +3445,7 @@ package body Parse is -- precond : '[' -- postcond: next token after ']' -- - -- [ 2.3.2 ] + -- [ LRM93 2.3.2 ] -- signature ::= [ [ type_mark { , type_mark } ] [ RETURN type_mark ] ] function Parse_Signature return Iir_Signature is @@ -3481,7 +3501,7 @@ package body Parse is Res: Iir; Ident : Name_Id; begin - -- Eat 'alias'. + -- Skip 'alias'. Scan; Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); @@ -3500,7 +3520,7 @@ package body Parse is Error_Msg_Parse ("alias designator expected"); end case; - -- Eat identifier. + -- Skip identifier. Set_Identifier (Res, Ident); Scan; @@ -4500,9 +4520,18 @@ package body Parse is procedure Parse_Entity_Declaration (Unit : Iir_Design_Unit) is Res: Iir_Entity_Declaration; + Start_Loc : Location_Type; + Begin_Loc : Location_Type; + End_Loc : Location_Type; begin Expect (Tok_Entity); Res := Create_Iir (Iir_Kind_Entity_Declaration); + Start_Loc := Get_Token_Location; + + if Flag_Elocations then + Create_Elocations (Res); + Set_Start_Location (Res, Start_Loc); + end if; -- Get identifier. Scan_Expect (Tok_Identifier, @@ -4520,12 +4549,15 @@ package body Parse is if Current_Token = Tok_Begin then Set_Has_Begin (Res, True); Scan; + Begin_Loc := Get_Token_Location; Parse_Concurrent_Statements (Res); + else + Begin_Loc := No_Location; end if; -- end keyword is expected to finish an entity declaration Expect (Tok_End); - Set_End_Location (Unit); + End_Loc := Get_Token_Location; Scan; if Current_Token = Tok_Entity then @@ -4539,6 +4571,11 @@ package body Parse is Expect (Tok_Semi_Colon); Invalidate_Current_Token; Set_Library_Unit (Unit, Res); + + if Flag_Elocations then + Set_Begin_Location (Res, Begin_Loc); + Set_End_Location (Res, End_Loc); + end if; end Parse_Entity_Declaration; -- [ LRM93 7.3.2 ] @@ -4546,7 +4583,7 @@ package body Parse is -- | discrete_range -- | ELEMENT_simple_name -- | OTHERS - function Parse_A_Choice (Expr: Iir) return Iir + function Parse_A_Choice (Expr: Iir; Loc : Location_Type) return Iir is A_Choice: Iir; Expr1: Iir; @@ -4554,7 +4591,7 @@ package body Parse is if Expr = Null_Iir then if Current_Token = Tok_Others then A_Choice := Create_Iir (Iir_Kind_Choice_By_Others); - Set_Location (A_Choice); + Set_Location (A_Choice, Loc); -- Skip 'others' Scan; @@ -4567,56 +4604,63 @@ package body Parse is -- Handle parse error now. -- FIXME: skip until '=>'. A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); - Set_Location (A_Choice); + Set_Location (A_Choice, Loc); return A_Choice; end if; end if; else Expr1 := Expr; end if; + if Is_Range_Attribute_Name (Expr1) then A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); - Location_Copy (A_Choice, Expr1); Set_Choice_Range (A_Choice, Expr1); - return A_Choice; elsif Current_Token = Tok_To or else Current_Token = Tok_Downto then A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); - Location_Copy (A_Choice, Expr1); Set_Choice_Range (A_Choice, Parse_Range_Expression (Expr1)); - return A_Choice; else A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); - Location_Copy (A_Choice, Expr1); Set_Choice_Expression (A_Choice, Expr1); - return A_Choice; end if; + + Set_Location (A_Choice, Loc); + return A_Choice; end Parse_A_Choice; -- [ LRM93 7.3.2 ] -- choices ::= choice { | choice } -- -- Leave tok_double_arrow as current token. - function Parse_Choices (Expr: Iir) return Iir + function Parse_Choices (Expr: Iir; First_Loc : Location_Type) return Iir is First, Last : Iir; A_Choice: Iir; Expr1 : Iir; + Loc : Location_Type; begin Sub_Chain_Init (First, Last); Expr1 := Expr; + Loc := First_Loc; loop - A_Choice := Parse_A_Choice (Expr1); + A_Choice := Parse_A_Choice (Expr1, Loc); + if First /= Null_Iir then Set_Same_Alternative_Flag (A_Choice, True); if Get_Kind (A_Choice) = Iir_Kind_Choice_By_Others then Error_Msg_Parse ("'others' choice must be alone"); end if; end if; + Sub_Chain_Append (First, Last, A_Choice); + if Current_Token /= Tok_Bar then return First; end if; + Loc := Get_Token_Location; + + -- Skip '|'. Scan; + Expr1 := Null_Iir; end loop; end Parse_Choices; @@ -4654,9 +4698,9 @@ package body Parse is -- This is really an aggregate null; when Tok_Right_Paren => - -- This was just a braced expression. + -- This was just a braced expression. - -- Eat ')'. + -- Skip ')'. Scan; if Get_Kind (Expr) = Iir_Kind_Aggregate then @@ -4694,36 +4738,51 @@ package body Parse is Build_Init (Last); loop if Current_Token = Tok_Others then - Assoc := Parse_A_Choice (Null_Iir); + Assoc := Parse_A_Choice (Null_Iir, Loc); Expect (Tok_Double_Arrow); + + -- Eat '=>' Scan; + Expr := Parse_Expression; else + -- Not others: an expression (or a range). if Expr = Null_Iir then Expr := Parse_Expression; end if; if Expr = Null_Iir then return Null_Iir; end if; + case Current_Token is when Tok_Comma | Tok_Right_Paren => Assoc := Create_Iir (Iir_Kind_Choice_By_None); - Location_Copy (Assoc, Expr); + Set_Location (Assoc, Loc); when others => - Assoc := Parse_Choices (Expr); + Assoc := Parse_Choices (Expr, Loc); Expect (Tok_Double_Arrow); + + -- Eat '=>'. Scan; + Expr := Parse_Expression; end case; end if; Set_Associated_Expr (Assoc, Expr); Append_Subchain (Last, Res, Assoc); exit when Current_Token = Tok_Right_Paren; + + Loc := Get_Token_Location; Expect (Tok_Comma); + + -- Eat ',' Scan; + Expr := Null_Iir; end loop; + + -- Eat ')'. Scan; return Res; end Parse_Aggregate; @@ -5595,7 +5654,7 @@ package body Parse is Cond_Wf := Res; loop - -- Eat 'when' + -- Skip 'when'. Scan; Set_Condition (Cond_Wf, Parse_Expression); @@ -5697,11 +5756,12 @@ package body Parse is function Parse_Selected_Signal_Assignment return Iir is use Iir_Chains.Selected_Waveform_Chain_Handling; - Res: Iir; - Assoc: Iir; + Res : Iir; + Assoc : Iir; Wf_Chain : Iir_Waveform_Element; Target : Iir; Last : Iir; + When_Loc : Location_Type; begin Scan; -- accept 'with' token. Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment); @@ -5725,8 +5785,12 @@ package body Parse is loop Wf_Chain := Parse_Waveform; Expect (Tok_When, "'when' expected after waveform"); + When_Loc := Get_Token_Location; + + -- Eat 'when'. Scan; - Assoc := Parse_Choices (Null_Iir); + + Assoc := Parse_Choices (Null_Iir, When_Loc); Set_Associated_Chain (Assoc, Wf_Chain); Append_Subchain (Last, Res, Assoc); exit when Current_Token = Tok_Semi_Colon; @@ -5918,24 +5982,42 @@ package body Parse is Res: Iir_If_Statement; Clause: Iir; N_Clause: Iir; + Start_Loc, Then_Loc, End_Loc : Location_Type; begin Res := Create_Iir (Iir_Kind_If_Statement); - Set_Location (Res); + Start_Loc := Get_Token_Location; + Set_Location (Res, Start_Loc); Set_Parent (Res, Parent); + + -- Eat 'if'. Scan; + Clause := Res; loop Set_Condition (Clause, Parse_Expression); Expect (Tok_Then, "'then' is expected here"); + Then_Loc := Get_Token_Location; - -- Skip 'then'. + -- Eat 'then'. Scan; Set_Sequential_Statement_Chain (Clause, Parse_Sequential_Statements (Res)); + + End_Loc := Get_Token_Location; + + if Flag_Elocations then + Create_Elocations (Clause); + Set_Start_Location (Clause, Start_Loc); + Set_Then_Location (Clause, Then_Loc); + Set_End_Location (Clause, End_Loc); + end if; + exit when Current_Token = Tok_End; + N_Clause := Create_Iir (Iir_Kind_Elsif); - Set_Location (N_Clause); + Start_Loc := Get_Token_Location; + Set_Location (N_Clause, Start_Loc); Set_Else_Clause (Clause, N_Clause); Clause := N_Clause; if Current_Token = Tok_Else then @@ -5945,6 +6027,13 @@ package body Parse is Set_Sequential_Statement_Chain (Clause, Parse_Sequential_Statements (Res)); + + if Flag_Elocations then + Create_Elocations (Clause); + Set_Start_Location (Clause, Start_Loc); + Set_End_Location (Clause, Get_Token_Location); + end if; + exit; elsif Current_Token = Tok_Elsif then -- Skip 'elsif'. @@ -5955,7 +6044,10 @@ package body Parse is end loop; Expect (Tok_End); Scan_Expect (Tok_If); + + -- Eat 'if'. Scan; + return Res; end Parse_If_Statement; @@ -6036,7 +6128,7 @@ package body Parse is Set_Location (Stmt); Set_Target (Stmt, Target); - -- Eat '<='. + -- Skip '<='. Scan; Parse_Delay_Mechanism (Stmt); @@ -6093,7 +6185,7 @@ package body Parse is El := Res; loop - -- Eat 'when' + -- Skip 'when'. Scan; Set_Condition (El, Parse_Expression); @@ -6105,7 +6197,7 @@ package body Parse is Set_Chain (El, N_El); El := N_El; - -- Eat 'else' + -- Skip 'else'. Scan; Set_Expression (N_El, Parse_Expression); @@ -6130,7 +6222,7 @@ package body Parse is begin Loc := Get_Token_Location; - -- Eat ':=' + -- Skip ':='. Scan; Expr := Parse_Expression; @@ -6185,7 +6277,7 @@ package body Parse is -- precond: CASE -- postcond: ';' -- - -- [ 8.8 ] + -- [ LRM93 8.8 ] -- case_statement ::= -- [ CASE_label : ] -- CASE expression IS @@ -6193,7 +6285,7 @@ package body Parse is -- { case_statement_alternative } -- END CASE [ CASE_label ] ; -- - -- [ 8.8 ] + -- [ LRM93 8.8 ] -- case_statement_alternative ::= WHEN choices => sequence_of_statements function Parse_Case_Statement (Label : Name_Id) return Iir is @@ -6201,6 +6293,7 @@ package body Parse is Stmt : Iir; Assoc: Iir; Last_Assoc : Iir; + When_Loc : Location_Type; begin Stmt := Create_Iir (Iir_Kind_Case_Statement); Set_Label (Stmt, Label); @@ -6214,24 +6307,28 @@ package body Parse is -- Skip 'is'. Expect (Tok_Is); Scan; + if Current_Token = Tok_End then Error_Msg_Parse ("missing alternative in case statement"); end if; + Build_Init (Last_Assoc); while Current_Token /= Tok_End loop - -- Eat 'when' Expect (Tok_When); + When_Loc := Get_Token_Location; + + -- Skip 'when'. Scan; if Current_Token = Tok_Double_Arrow then Error_Msg_Parse ("missing expression in alternative"); Assoc := Create_Iir (Iir_Kind_Choice_By_Expression); - Set_Location (Assoc); + Set_Location (Assoc, When_Loc); else - Assoc := Parse_Choices (Null_Iir); + Assoc := Parse_Choices (Null_Iir, When_Loc); end if; - -- Eat '=>' + -- Skip '=>'. Expect (Tok_Double_Arrow); Scan; @@ -6239,7 +6336,12 @@ package body Parse is Append_Subchain (Last_Assoc, Stmt, Assoc); end loop; - -- Eat 'end', 'case' + if Flag_Elocations then + Create_Elocations (Stmt); + Set_End_Location (Stmt, Get_Token_Location); + end if; + + -- Skip 'end', 'case'. Scan_Expect (Tok_Case); Scan; @@ -6250,6 +6352,63 @@ package body Parse is return Stmt; end Parse_Case_Statement; + -- precond: FOR + -- postcond: ';' + -- + -- [ LRM93 8.9 ] + -- loop_statement ::= + -- [ LOOP_label : ] + -- [ iteration_scheme ] LOOP + -- sequence_of_statements + -- END LOOP [ LOOP_label ] ; + -- + -- [ LRM93 8.9 ] + -- iteration_scheme ::= WHILE condition + -- | FOR LOOP_parameter_specification + function Parse_For_Loop_Statement (Label : Name_Id) return Iir + is + Stmt : Iir; + Start_Loc, Loop_Loc, End_Loc : Location_Type; + begin + Stmt := Create_Iir (Iir_Kind_For_Loop_Statement); + Start_Loc := Get_Token_Location; + Set_Location (Stmt, Start_Loc); + Set_Label (Stmt, Label); + + -- Skip 'for' + Scan; + + Set_Parameter_Specification + (Stmt, Parse_Parameter_Specification (Stmt)); + + -- Skip 'loop' + Loop_Loc := Get_Token_Location; + Expect (Tok_Loop); + Scan; + + Set_Sequential_Statement_Chain + (Stmt, Parse_Sequential_Statements (Stmt)); + + -- Skip 'end' + End_Loc := Get_Token_Location; + Expect (Tok_End); + Scan_Expect (Tok_Loop); + + -- Skip 'loop' + Scan; + + Check_End_Name (Stmt); + + if Flag_Elocations then + Create_Elocations (Stmt); + Set_Start_Location (Stmt, Start_Loc); + Set_Loop_Location (Stmt, Loop_Loc); + Set_End_Location (Stmt, End_Loc); + end if; + + return Stmt; + end Parse_For_Loop_Statement; + -- precond: next token -- postcond: next token -- @@ -6380,31 +6539,9 @@ package body Parse is end if; when Tok_For => - Stmt := Create_Iir (Iir_Kind_For_Loop_Statement); + Stmt := Parse_For_Loop_Statement (Label); Set_Location (Stmt, Loc); - Set_Label (Stmt, Label); - -- Skip 'for' - Scan; - - Set_Parameter_Specification - (Stmt, Parse_Parameter_Specification (Stmt)); - - -- Skip 'loop' - Expect (Tok_Loop); - Scan; - - Set_Sequential_Statement_Chain - (Stmt, Parse_Sequential_Statements (Stmt)); - - -- Skip 'end' - Expect (Tok_End); - Scan_Expect (Tok_Loop); - - -- Skip 'loop' - Scan; - - Check_End_Name (Stmt); -- A loop statement can have a label, even in vhdl87. Label := Null_Identifier; @@ -6508,8 +6645,8 @@ package body Parse is Kind : Iir_Kind; Subprg: Iir; Subprg_Body : Iir; - Old : Iir; - pragma Unreferenced (Old); + Begin_Loc : Location_Type; + End_Loc : Location_Type; begin -- Create the node. case Current_Token is @@ -6585,6 +6722,7 @@ package body Parse is Parse_Declarative_Part (Subprg_Body); -- Skip 'begin'. + Begin_Loc := Get_Token_Location; Expect (Tok_Begin); Scan; @@ -6592,9 +6730,16 @@ package body Parse is (Subprg_Body, Parse_Sequential_Statements (Subprg_Body)); -- Skip 'end'. + End_Loc := Get_Token_Location; Expect (Tok_End); Scan; + if Flag_Elocations then + Create_Elocations (Subprg_Body); + Set_Begin_Location (Subprg_Body, Begin_Loc); + Set_End_Location (Subprg_Body, End_Loc); + end if; + case Current_Token is when Tok_Function => if Flags.Vhdl_Std = Vhdl_87 then @@ -6641,6 +6786,7 @@ package body Parse is null; end case; Expect (Tok_Semi_Colon); + return Subprg; end Parse_Subprogram_Declaration; @@ -6663,7 +6809,10 @@ package body Parse is is Res: Iir; Sensitivity_List : Iir_List; + Start_Loc, Begin_Loc, End_Loc : Location_Type; begin + Start_Loc := Get_Token_Location; + -- Skip 'process' Scan; @@ -6714,12 +6863,14 @@ package body Parse is -- Skip 'begin'. Expect (Tok_Begin); + Begin_Loc := Get_Token_Location; Scan; Set_Sequential_Statement_Chain (Res, Parse_Sequential_Statements (Res)); -- Skip 'end'. Expect (Tok_End); + End_Loc := Get_Token_Location; Scan; if Current_Token = Tok_Postponed then @@ -6745,6 +6896,14 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); end if; + + if Flag_Elocations then + Create_Elocations (Res); + Set_Start_Location (Res, Start_Loc); + Set_Begin_Location (Res, Begin_Loc); + Set_End_Location (Res, End_Loc); + end if; + return Res; end Parse_Process_Statement; @@ -7059,6 +7218,7 @@ package body Parse is is Res : Iir_Block_Statement; Guard : Iir_Guard_Signal_Declaration; + Begin_Loc : Location_Type; begin if Label = Null_Identifier then Error_Msg_Parse ("a block statement must have a label"); @@ -7068,20 +7228,30 @@ package body Parse is Res := Create_Iir (Iir_Kind_Block_Statement); Set_Location (Res, Loc); Set_Label (Res, Label); + + -- Eat 'block'. Scan; + if Current_Token = Tok_Left_Paren then Guard := Create_Iir (Iir_Kind_Guard_Signal_Declaration); Set_Location (Guard); Set_Guard_Decl (Res, Guard); + + -- Eat '('. Scan; Set_Guard_Expression (Guard, Parse_Expression); Expect (Tok_Right_Paren, "a ')' is expected after guard expression"); + + -- Eat ')'. Scan; end if; + if Current_Token = Tok_Is then if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("'is' not allowed here in vhdl87"); end if; + + -- Eat 'is'. Scan; end if; if Current_Token = Tok_Generic or Current_Token = Tok_Port then @@ -7090,9 +7260,21 @@ package body Parse is if Current_Token /= Tok_Begin then Parse_Declarative_Part (Res); end if; + Expect (Tok_Begin); + Begin_Loc := Get_Token_Location; + + -- Eat 'begin'. Scan; + Parse_Concurrent_Statements (Res); + + if Flag_Elocations then + Create_Elocations (Res); + Set_Begin_Location (Res, Begin_Loc); + Set_End_Location (Res, Get_Token_Location); + end if; + Check_End_Name (Tok_Block, Res); return Res; end Parse_Block_Statement; @@ -7478,7 +7660,7 @@ package body Parse is Set_Location (Assoc); elsif Current_Token = Tok_Others then -- 'others' is not an expression! - Assoc := Parse_Choices (Null_Iir); + Assoc := Parse_Choices (Null_Iir, Loc); else Expr := Parse_Expression; @@ -7499,7 +7681,7 @@ package body Parse is Scan; end if; - Assoc := Parse_Choices (Expr); + Assoc := Parse_Choices (Expr, Loc); end if; -- Set location of label (if any, for xref) or location of 'when'. @@ -7911,11 +8093,13 @@ package body Parse is is First, Last : Iir; Library: Iir_Library_Clause; + Start_Loc : Location_Type; begin Sub_Chain_Init (First, Last); Expect (Tok_Library); loop Library := Create_Iir (Iir_Kind_Library_Clause); + Start_Loc := Get_Token_Location; -- Skip 'library' or ','. Scan_Expect (Tok_Identifier); @@ -7927,6 +8111,11 @@ package body Parse is -- Skip identifier. Scan; + if Flag_Elocations then + Create_Elocations (Library); + Set_Start_Location (Library, Start_Loc); + end if; + exit when Current_Token = Tok_Semi_Colon; Expect (Tok_Comma); @@ -7948,14 +8137,20 @@ package body Parse is function Parse_Use_Clause return Iir_Use_Clause is Use_Clause: Iir_Use_Clause; + Loc : Location_Type; First, Last : Iir; begin First := Null_Iir; Last := Null_Iir; + + Loc := Get_Token_Location; + + -- Skip 'use'. Scan; + loop Use_Clause := Create_Iir (Iir_Kind_Use_Clause); - Set_Location (Use_Clause); + Set_Location (Use_Clause, Loc); Expect (Tok_Identifier); Set_Selected_Name (Use_Clause, Parse_Name); @@ -7969,6 +8164,9 @@ package body Parse is exit when Current_Token = Tok_Semi_Colon; Expect (Tok_Comma); + Loc := Get_Token_Location; + + -- Skip ','. Scan; end loop; return First; @@ -7986,33 +8184,47 @@ package body Parse is -- END [ ARCHITECTURE ] [ ARCHITECTURE_simple_name ] ; procedure Parse_Architecture_Body (Unit : Iir_Design_Unit) is - Res: Iir_Architecture_Body; + Res : Iir_Architecture_Body; + Start_Loc : Location_Type; + Begin_Loc : Location_Type; + End_Loc : Location_Type; begin Expect (Tok_Architecture); Res := Create_Iir (Iir_Kind_Architecture_Body); + Start_Loc := Get_Token_Location; -- Get identifier. Scan_Expect (Tok_Identifier); Set_Identifier (Res, Current_Identifier); Set_Location (Res); + + -- Skip identifier. Scan; if Current_Token = Tok_Is then Error_Msg_Parse ("architecture identifier is missing"); else Expect (Tok_Of); + + -- Skip 'of'. Scan; Set_Entity_Name (Res, Parse_Name (False)); Expect (Tok_Is); end if; + -- Skip 'is'. Scan; Parse_Declarative_Part (Res); + -- Skip 'begin'. Expect (Tok_Begin); + Begin_Loc := Get_Token_Location; Scan; + Parse_Concurrent_Statements (Res); -- end was scanned. - Set_End_Location (Unit); + End_Loc := Get_Token_Location; + + -- Skip 'end'. Scan; if Current_Token = Tok_Architecture then if Flags.Vhdl_Std = Vhdl_87 then @@ -8025,6 +8237,13 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); Set_Library_Unit (Unit, Res); + + if Flag_Elocations then + Create_Elocations (Res); + Set_Start_Location (Res, Start_Loc); + Set_Begin_Location (Res, Begin_Loc); + Set_End_Location (Res, End_Loc); + end if; end Parse_Architecture_Body; -- precond : next token @@ -8396,11 +8615,12 @@ package body Parse is procedure Parse_Configuration_Declaration (Unit : Iir_Design_Unit) is Res : Iir_Configuration_Declaration; + Start_Loc : Location_Type; + End_Loc : Location_Type; begin - if Current_Token /= Tok_Configuration then - raise Program_Error; - end if; + pragma Assert (Current_Token = Tok_Configuration); Res := Create_Iir (Iir_Kind_Configuration_Declaration); + Start_Loc := Get_Token_Location; -- Get identifier. Scan_Expect (Tok_Identifier); @@ -8424,7 +8644,7 @@ package body Parse is Set_Block_Configuration (Res, Parse_Block_Configuration); Scan_Expect (Tok_End); - Set_End_Location (Unit); + End_Loc := Get_Token_Location; -- Skip 'end'. Scan; @@ -8446,6 +8666,12 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); Set_Library_Unit (Unit, Res); + + if Flag_Elocations then + Create_Elocations (Res); + Set_Start_Location (Res, Start_Loc); + Set_End_Location (Res, End_Loc); + end if; end Parse_Configuration_Declaration; -- precond : generic @@ -8480,10 +8706,10 @@ package body Parse is -- package_declarative_part -- END [ PACKAGE ] [ PACKAGE_simple_name ] ; function Parse_Package_Declaration - (Parent : Iir; Id : Name_Id; Loc : Location_Type) - return Iir + (Parent : Iir; Id : Name_Id; Loc : Location_Type) return Iir is Res: Iir_Package_Declaration; + End_Loc : Location_Type; begin Res := Create_Iir (Iir_Kind_Package_Declaration); Set_Location (Res, Loc); @@ -8500,7 +8726,7 @@ package body Parse is Parse_Declarative_Part (Res); Expect (Tok_End); - Set_End_Location (Parent); + End_Loc := Get_Token_Location; -- Skip 'end' Scan; @@ -8517,6 +8743,12 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); + + if Flag_Elocations then + Create_Elocations (Res); + Set_End_Location (Res, End_Loc); + end if; + return Res; end Parse_Package_Declaration; @@ -8530,7 +8762,8 @@ package body Parse is -- END [ PACKAGE BODY ] [ PACKAGE_simple_name ] ; function Parse_Package_Body (Parent : Iir) return Iir is - Res: Iir; + Res : Iir; + End_Loc : Location_Type; begin Res := Create_Iir (Iir_Kind_Package_Body); Set_Location (Res); @@ -8545,7 +8778,7 @@ package body Parse is Parse_Declarative_Part (Res); Expect (Tok_End); - Set_End_Location (Parent); + End_Loc := Get_Token_Location; -- Skip 'end' Scan; @@ -8569,6 +8802,12 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); + + if Flag_Elocations then + Create_Elocations (Res); + Set_End_Location (Res, End_Loc); + end if; + return Res; end Parse_Package_Body; @@ -8604,6 +8843,11 @@ package body Parse is Expect (Tok_Semi_Colon); + if Flag_Elocations then + Create_Elocations (Res); + Set_End_Location (Res, Get_Token_Location); + end if; + return Res; end Parse_Package_Instantiation_Declaration; @@ -8618,15 +8862,17 @@ package body Parse is Loc : Location_Type; Id : Name_Id; Res : Iir; + Start_Loc : Location_Type; begin -- Skip 'package' + Start_Loc := Get_Token_Location; Scan; if Current_Token = Tok_Body then -- Skip 'body' Scan; - return Parse_Package_Body (Parent); + Res := Parse_Package_Body (Parent); else Expect (Tok_Identifier); Id := Current_Identifier; @@ -8642,12 +8888,16 @@ package body Parse is if Current_Token = Tok_New then Res := Parse_Package_Instantiation_Declaration (Parent, Id, Loc); -- Note: there is no 'end' in instantiation. - Set_End_Location (Parent); - return Res; else - return Parse_Package_Declaration (Parent, Id, Loc); + Res := Parse_Package_Declaration (Parent, Id, Loc); end if; end if; + + if Flag_Elocations then + Set_Start_Location (Res, Start_Loc); + end if; + + return Res; end Parse_Package; procedure Parse_Context_Declaration_Or_Reference @@ -8715,7 +8965,9 @@ package body Parse is -- CONTEXT identifier IS -- context_clause -- END [ CONTEXT ] [ /context/_simple_name ] ; - procedure Parse_Context_Declaration (Unit : Iir; Decl : Iir) is + procedure Parse_Context_Declaration (Unit : Iir; Decl : Iir) + is + End_Loc : Location_Type; begin Set_Library_Unit (Unit, Decl); @@ -8725,7 +8977,7 @@ package body Parse is Parse_Context_Clause (Decl); Expect (Tok_End); - Set_End_Location (Unit); + End_Loc := Get_Token_Location; -- Skip 'end' Scan; @@ -8739,6 +8991,11 @@ package body Parse is Check_End_Name (Decl); Expect (Tok_Semi_Colon); + + if Flag_Elocations then + Create_Elocations (Decl); + Set_End_Location (Decl, End_Loc); + end if; end Parse_Context_Declaration; -- Precond: next token after selected_name. diff --git a/src/vhdl/python/libghdl/thin.py b/src/vhdl/python/libghdl/thin.py index 71b375c73..07a5e80d6 100644 --- a/src/vhdl/python/libghdl/thin.py +++ b/src/vhdl/python/libghdl/thin.py @@ -77,6 +77,11 @@ def Get_Identifier(s): return _Get_Identifier_With_Len(c_char_p(s), len(s)) +# Flags +class Flags: + Flag_Elocations = c_bool.in_dll(libghdl, "flags__flag_elocations") + + # Scanner class Scanner: Set_File = libghdl.scanner__set_file diff --git a/src/vhdl/python/pnodespy.py b/src/vhdl/python/pnodespy.py index b846c01b0..d0168784c 100755 --- a/src/vhdl/python/pnodespy.py +++ b/src/vhdl/python/pnodespy.py @@ -39,6 +39,19 @@ def do_iirs_subprg(): k.name, libname, classname, k.name.lower(), k.pname, k.rname) +def do_libghdl_elocations(): + classname = 'elocations' + print 'from libghdl import libghdl' + print + for k in pnodes.funcs: + print + print 'Get_{0} = {1}.{2}__get_{3}'.format( + k.name, libname, classname, k.name.lower()) + print + print 'Set_{0} = {1}.{2}__set_{3}'.format( + k.name, libname, classname, k.name.lower(), k.pname, k.rname) + + def do_class_types(): print_enum('types', pnodes.get_types()) @@ -178,7 +191,8 @@ pnodes.actions.update({'class-kinds': do_class_kinds, 'libghdl-iirs': do_libghdl_iirs, 'libghdl-meta': do_libghdl_meta, 'libghdl-names': do_libghdl_names, - 'libghdl-tokens': do_libghdl_tokens}) + 'libghdl-tokens': do_libghdl_tokens, + 'libghdl-elocs': do_libghdl_elocations}) pnodes.main() diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index 669a3de56..eee370cb0 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -314,9 +314,6 @@ package body Sem_Inst is (Res, F, Get_Iir_Predefined_Functions (N, F)); when Type_Iir_Direction => Set_Iir_Direction (Res, F, Get_Iir_Direction (N, F)); - when Type_Location_Type => - Set_Location_Type - (Res, F, Relocate (Get_Location_Type (N, F))); when Type_Iir_Int32 => Set_Iir_Int32 (Res, F, Get_Iir_Int32 (N, F)); when Type_Int32 => diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 7798c93a8..790200218 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1448,7 +1448,6 @@ package body Trans.Chap2 is | Type_Iir_Delay_Mechanism | Type_Iir_Predefined_Functions | Type_Iir_Direction - | Type_Location_Type | Type_Iir_Int32 | Type_Int32 | Type_Iir_Fp64 diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 2f001666e..bd8bcde4b 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -1218,7 +1218,6 @@ package body Trans.Chap9 is | Type_Iir_Delay_Mechanism | Type_Iir_Predefined_Functions | Type_Iir_Direction - | Type_Location_Type | Type_Iir_Int32 | Type_Int32 | Type_Iir_Fp64 |