aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/elocations.adb48
-rw-r--r--src/vhdl/elocations.adb.in8
-rw-r--r--src/vhdl/elocations.ads24
-rw-r--r--src/vhdl/elocations_meta.adb38
-rw-r--r--src/vhdl/elocations_meta.ads6
-rw-r--r--src/vhdl/parse.adb60
6 files changed, 154 insertions, 30 deletions
diff --git a/src/vhdl/elocations.adb b/src/vhdl/elocations.adb
index b4466d42a..9ba4f8325 100644
--- a/src/vhdl/elocations.adb
+++ b/src/vhdl/elocations.adb
@@ -130,6 +130,14 @@ package body Elocations is
Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location);
end Create_Elocations;
+ procedure Delete_Elocations (N : Iir) is
+ begin
+ -- Clear the corresponding index.
+ Elocations_Index_Table.Table (N) := No_Location_Index;
+
+ -- FIXME: keep free slots in chained list ?
+ end Delete_Elocations;
+
generic
Off : Location_Index_Type;
function Get_FieldX (N : Iir) return Location_Type;
@@ -410,10 +418,6 @@ package body Elocations is
| 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_Parenthesis_Expression
@@ -431,6 +435,10 @@ package body Elocations is
| Iir_Kind_Case_Statement =>
return Format_L2;
when Iir_Kind_Package_Instantiation_Declaration
+ | Iir_Kind_Interface_Constant_Declaration
+ | Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Interface_File_Declaration
| Iir_Kind_If_Generate_Statement
| Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
@@ -667,4 +675,36 @@ package body Elocations is
Set_Field1 (N, Loc);
end Set_Arrow_Location;
+ function Get_Colon_Location (N : Iir) return Location_Type is
+ begin
+ pragma Assert (N /= Null_Iir);
+ pragma Assert (Has_Colon_Location (Get_Kind (N)),
+ "no field Colon_Location");
+ return Get_Field2 (N);
+ end Get_Colon_Location;
+
+ procedure Set_Colon_Location (N : Iir; Loc : Location_Type) is
+ begin
+ pragma Assert (N /= Null_Iir);
+ pragma Assert (Has_Colon_Location (Get_Kind (N)),
+ "no field Colon_Location");
+ Set_Field2 (N, Loc);
+ end Set_Colon_Location;
+
+ function Get_Assign_Location (N : Iir) return Location_Type is
+ begin
+ pragma Assert (N /= Null_Iir);
+ pragma Assert (Has_Assign_Location (Get_Kind (N)),
+ "no field Assign_Location");
+ return Get_Field3 (N);
+ end Get_Assign_Location;
+
+ procedure Set_Assign_Location (N : Iir; Loc : Location_Type) is
+ begin
+ pragma Assert (N /= Null_Iir);
+ pragma Assert (Has_Assign_Location (Get_Kind (N)),
+ "no field Assign_Location");
+ Set_Field3 (N, Loc);
+ end Set_Assign_Location;
+
end Elocations;
diff --git a/src/vhdl/elocations.adb.in b/src/vhdl/elocations.adb.in
index 5b9ef84ba..95a73dd54 100644
--- a/src/vhdl/elocations.adb.in
+++ b/src/vhdl/elocations.adb.in
@@ -130,6 +130,14 @@ package body Elocations is
Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location);
end Create_Elocations;
+ procedure Delete_Elocations (N : Iir) is
+ begin
+ -- Clear the corresponding index.
+ Elocations_Index_Table.Table (N) := No_Location_Index;
+
+ -- FIXME: keep free slots in chained list ?
+ end Delete_Elocations;
+
generic
Off : Location_Index_Type;
function Get_FieldX (N : Iir) return Location_Type;
diff --git a/src/vhdl/elocations.ads b/src/vhdl/elocations.ads
index 629d6707f..82450debd 100644
--- a/src/vhdl/elocations.ads
+++ b/src/vhdl/elocations.ads
@@ -215,12 +215,16 @@ package Elocations is
-- 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)
+ -- Iir_Kind_Interface_Signal_Declaration (L3)
+ -- Iir_Kind_Interface_Constant_Declaration (L3)
+ -- Iir_Kind_Interface_Variable_Declaration (L3)
+ -- Iir_Kind_Interface_File_Declaration (L3)
--
-- Get/Set_Start_Location (Field1)
+ --
+ -- Get/Set_Colon_Location (Field2)
+ --
+ -- Get/Set_Assign_Location (Field3)
-- Iir_Kind_Interface_Type_Declaration (L1)
--
@@ -627,6 +631,10 @@ package Elocations is
-- Allocate memory to store elocations for node N. Must be called once.
procedure Create_Elocations (N : Iir);
+ -- Delete locations. Memory is not yet reclaimed (but doesn't happen
+ -- frequently).
+ procedure Delete_Elocations (N : Iir);
+
-- General methods.
-- Field: Field1
@@ -680,4 +688,12 @@ package Elocations is
-- Field: Field1
function Get_Arrow_Location (N : Iir) return Location_Type;
procedure Set_Arrow_Location (N : Iir; Loc : Location_Type);
+
+ -- Field: Field2
+ function Get_Colon_Location (N : Iir) return Location_Type;
+ procedure Set_Colon_Location (N : Iir; Loc : Location_Type);
+
+ -- Field: Field3
+ function Get_Assign_Location (N : Iir) return Location_Type;
+ procedure Set_Assign_Location (N : Iir; Loc : Location_Type);
end Elocations;
diff --git a/src/vhdl/elocations_meta.adb b/src/vhdl/elocations_meta.adb
index fdc808429..1d66236a5 100644
--- a/src/vhdl/elocations_meta.adb
+++ b/src/vhdl/elocations_meta.adb
@@ -48,6 +48,10 @@ package body Elocations_Meta is
return "port_map_location";
when Field_Arrow_Location =>
return "arrow_location";
+ when Field_Colon_Location =>
+ return "colon_location";
+ when Field_Assign_Location =>
+ return "assign_location";
end case;
end Get_Field_Image;
@@ -93,6 +97,10 @@ package body Elocations_Meta is
return Get_Port_Map_Location (N);
when Field_Arrow_Location =>
return Get_Arrow_Location (N);
+ when Field_Colon_Location =>
+ return Get_Colon_Location (N);
+ when Field_Assign_Location =>
+ return Get_Assign_Location (N);
when others =>
raise Internal_Error;
end case;
@@ -129,6 +137,10 @@ package body Elocations_Meta is
Set_Port_Map_Location (N, V);
when Field_Arrow_Location =>
Set_Arrow_Location (N, V);
+ when Field_Colon_Location =>
+ Set_Colon_Location (N, V);
+ when Field_Assign_Location =>
+ Set_Assign_Location (N, V);
when others =>
raise Internal_Error;
end case;
@@ -362,6 +374,32 @@ package body Elocations_Meta is
end case;
end Has_Arrow_Location;
+ function Has_Colon_Location (K : Iir_Kind) return Boolean is
+ begin
+ case K is
+ when Iir_Kind_Interface_Constant_Declaration
+ | Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Interface_File_Declaration =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Colon_Location;
+
+ function Has_Assign_Location (K : Iir_Kind) return Boolean is
+ begin
+ case K is
+ when Iir_Kind_Interface_Constant_Declaration
+ | Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Interface_File_Declaration =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Assign_Location;
+
pragma Warnings (On, """others"" choice is redundant");
end Elocations_Meta;
diff --git a/src/vhdl/elocations_meta.ads b/src/vhdl/elocations_meta.ads
index c2e968248..549951408 100644
--- a/src/vhdl/elocations_meta.ads
+++ b/src/vhdl/elocations_meta.ads
@@ -35,7 +35,9 @@ package Elocations_Meta is
Field_Port_Location,
Field_Generic_Map_Location,
Field_Port_Map_Location,
- Field_Arrow_Location
+ Field_Arrow_Location,
+ Field_Colon_Location,
+ Field_Assign_Location
);
pragma Discard_Names (Fields_Enum);
@@ -62,4 +64,6 @@ package Elocations_Meta is
function Has_Generic_Map_Location (K : Iir_Kind) return Boolean;
function Has_Port_Map_Location (K : Iir_Kind) return Boolean;
function Has_Arrow_Location (K : Iir_Kind) return Boolean;
+ function Has_Colon_Location (K : Iir_Kind) return Boolean;
+ function Has_Assign_Location (K : Iir_Kind) return Boolean;
end Elocations_Meta;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 5bae26b22..87f65b003 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -1134,8 +1134,8 @@ package body Parse is
return Iir
is
Kind : Iir_Kind;
- Res, Last : Iir;
- First, Prev_First : Iir;
+ Last : Iir;
+ First : Iir;
Inter: Iir;
Is_Default : Boolean;
Interface_Mode: Iir_Mode;
@@ -1146,9 +1146,6 @@ package body Parse is
Has_Mode : Boolean;
Has_Class : Boolean;
begin
- Res := Null_Iir;
- Last := Null_Iir;
-
-- LRM08 6.5.2 Interface object declarations
-- Interface obejcts include interface constants that appear as
-- generics of a design entity, a component, a block, a package or
@@ -1198,7 +1195,12 @@ package body Parse is
Kind := Iir_Kind_Interface_Variable_Declaration;
end case;
- Inter := Create_Iir (Kind);
+ First := Create_Iir (Kind);
+
+ if Flag_Elocations then
+ Create_Elocations (First);
+ Set_Start_Location (First, Get_Token_Location);
+ end if;
if Current_Token = Tok_Identifier then
Is_Default := True;
@@ -1211,8 +1213,8 @@ package body Parse is
Scan;
end if;
- Prev_First := Last;
- First := Inter;
+ Inter := First;
+ Last := First;
loop
if Current_Token /= Tok_Identifier then
Expect (Tok_Identifier);
@@ -1220,13 +1222,6 @@ package body Parse is
Set_Identifier (Inter, Current_Identifier);
Set_Location (Inter);
- if Res = Null_Iir then
- Res := Inter;
- else
- Set_Chain (Last, Inter);
- end if;
- Last := Inter;
-
-- Skip identifier
Scan;
@@ -1237,11 +1232,22 @@ package body Parse is
Scan;
Inter := Create_Iir (Kind);
+
+ if Flag_Elocations then
+ Create_Elocations (Inter);
+ Set_Start_Location (Inter, Get_Start_Location (First));
+ end if;
+
+ Set_Chain (Last, Inter);
+ Last := Inter;
end loop;
Expect (Tok_Colon, "':' must follow the interface element identifier");
-- Skip ':'
+ if Flag_Elocations then
+ Set_Colon_Location (First, Get_Token_Location);
+ end if;
Scan;
-- Parse mode.
@@ -1277,17 +1283,26 @@ package body Parse is
Location_Copy (N_Interface, O_Interface);
Set_Identifier (N_Interface,
Get_Identifier (O_Interface));
- if Prev_First = Null_Iir then
- Res := N_Interface;
- else
- Set_Chain (Prev_First, N_Interface);
+
+ if Flag_Elocations then
+ Create_Elocations (N_Interface);
+ Set_Start_Location
+ (N_Interface, Get_Start_Location (O_Interface));
+ Set_Colon_Location
+ (N_Interface, Get_Colon_Location (O_Interface));
end if;
- Prev_First := N_Interface;
+
if O_Interface = First then
First := N_Interface;
+ else
+ Set_Chain (Last, N_Interface);
end if;
Last := N_Interface;
+
Inter := Get_Chain (O_Interface);
+ if Flag_Elocations then
+ Delete_Elocations (O_Interface);
+ end if;
Free_Iir (O_Interface);
O_Interface := Inter;
end loop;
@@ -1338,6 +1353,9 @@ package body Parse is
end if;
-- Skip ':='
+ if Flag_Elocations then
+ Set_Assign_Location (First, Get_Token_Location);
+ end if;
Scan;
Default_Value := Parse_Expression;
@@ -1366,7 +1384,7 @@ package body Parse is
Inter := Get_Chain (Inter);
end loop;
- return Res;
+ return First;
end Parse_Interface_Object_Declaration;
-- Precond : 'package'
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-30 05:45:19 +0000