diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-02-14 18:28:16 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-02-15 18:26:12 +0100 |
commit | 8669c8f94463850aa7cdcc2b8aa1e51c1a003bc8 (patch) | |
tree | 41b50aee596ed7c02dd5022f65b3d1411178c771 /src/vhdl | |
parent | 900f7cf3c4bcc331f460c278b09af2efd74ebff7 (diff) | |
download | ghdl-8669c8f94463850aa7cdcc2b8aa1e51c1a003bc8.tar.gz ghdl-8669c8f94463850aa7cdcc2b8aa1e51c1a003bc8.tar.bz2 ghdl-8669c8f94463850aa7cdcc2b8aa1e51c1a003bc8.zip |
Rework parse of object interface, add elocations.
Diffstat (limited to 'src/vhdl')
-rw-r--r-- | src/vhdl/elocations.adb | 48 | ||||
-rw-r--r-- | src/vhdl/elocations.adb.in | 8 | ||||
-rw-r--r-- | src/vhdl/elocations.ads | 24 | ||||
-rw-r--r-- | src/vhdl/elocations_meta.adb | 38 | ||||
-rw-r--r-- | src/vhdl/elocations_meta.ads | 6 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 60 |
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' |