diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/elocations.adb | 59 | ||||
| -rw-r--r-- | src/vhdl/elocations.adb.in | 25 | ||||
| -rw-r--r-- | src/vhdl/elocations.ads | 56 | ||||
| -rw-r--r-- | src/vhdl/elocations_meta.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 10 | ||||
| -rw-r--r-- | src/vhdl/parse.adb | 23 |
6 files changed, 138 insertions, 44 deletions
diff --git a/src/vhdl/elocations.adb b/src/vhdl/elocations.adb index 6ee8d0c2f..b4466d42a 100644 --- a/src/vhdl/elocations.adb +++ b/src/vhdl/elocations.adb @@ -29,7 +29,9 @@ package body Elocations is Format_L1, Format_L2, Format_L3, - Format_L5 + Format_L4, + Format_L5, + Format_L6 ); -- Common fields are: @@ -48,6 +50,12 @@ package body Elocations is -- Field2 : Location_Type -- Field3 : Location_Type + -- Fields of Format_L4: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Fields of Format_L5: -- Field1 : Location_Type -- Field2 : Location_Type @@ -55,6 +63,14 @@ package body Elocations is -- Field4 : Location_Type -- Field5 : Location_Type + -- Fields of Format_L6: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + -- Field6 : Location_Type + function Get_Format (Kind : Iir_Kind) return Format_Type; type Location_Index_Type is new Types.Nat32; @@ -100,8 +116,12 @@ package body Elocations is Len := 2; when Format_L3 => Len := 3; + when Format_L4 => + Len := 4; when Format_L5 => Len := 5; + when Format_L6 => + Len := 6; end case; Idx := Elocations_Table.Last + 1; @@ -153,6 +173,9 @@ package body Elocations is function Get_Field5 is new Get_FieldX (5); procedure Set_Field5 is new Set_FieldX (5); + function Get_Field6 is new Get_FieldX (6); + procedure Set_Field6 is new Set_FieldX (6); + -- Subprograms function Get_Format (Kind : Iir_Kind) return Format_Type is begin @@ -401,8 +424,6 @@ package body Elocations is when Iir_Kind_Protected_Type_Declaration | Iir_Kind_Record_Type_Definition | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Context_Declaration | Iir_Kind_Package_Declaration @@ -410,12 +431,6 @@ package body Elocations is | Iir_Kind_Case_Statement => return Format_L2; when Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement | Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement @@ -426,11 +441,21 @@ package body Elocations is | Iir_Kind_If_Statement | Iir_Kind_Elsif => return Format_L3; + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement => + return Format_L4; + when Iir_Kind_Package_Header => + return Format_L5; when Iir_Kind_Block_Header | Iir_Kind_Entity_Declaration - | Iir_Kind_Package_Header | Iir_Kind_Component_Declaration => - return Format_L5; + return Format_L6; end case; end Get_Format; @@ -487,7 +512,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Is_Location (Get_Kind (N)), "no field Is_Location"); - return Get_Field2 (N); + return Get_Field4 (N); end Get_Is_Location; procedure Set_Is_Location (N : Iir; Loc : Location_Type) is @@ -495,7 +520,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Is_Location (Get_Kind (N)), "no field Is_Location"); - Set_Field2 (N, Loc); + Set_Field4 (N, Loc); end Set_Is_Location; function Get_Begin_Location (N : Iir) return Location_Type is @@ -567,7 +592,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Generic_Location (Get_Kind (N)), "no field Generic_Location"); - return Get_Field4 (N); + return Get_Field5 (N); end Get_Generic_Location; procedure Set_Generic_Location (N : Iir; Loc : Location_Type) is @@ -575,7 +600,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Generic_Location (Get_Kind (N)), "no field Generic_Location"); - Set_Field4 (N, Loc); + Set_Field5 (N, Loc); end Set_Generic_Location; function Get_Port_Location (N : Iir) return Location_Type is @@ -583,7 +608,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Port_Location (Get_Kind (N)), "no field Port_Location"); - return Get_Field5 (N); + return Get_Field6 (N); end Get_Port_Location; procedure Set_Port_Location (N : Iir; Loc : Location_Type) is @@ -591,7 +616,7 @@ package body Elocations is pragma Assert (N /= Null_Iir); pragma Assert (Has_Port_Location (Get_Kind (N)), "no field Port_Location"); - Set_Field5 (N, Loc); + Set_Field6 (N, Loc); end Set_Port_Location; function Get_Generic_Map_Location (N : Iir) return Location_Type is diff --git a/src/vhdl/elocations.adb.in b/src/vhdl/elocations.adb.in index c4c8403b0..5b9ef84ba 100644 --- a/src/vhdl/elocations.adb.in +++ b/src/vhdl/elocations.adb.in @@ -29,7 +29,9 @@ package body Elocations is Format_L1, Format_L2, Format_L3, - Format_L5 + Format_L4, + Format_L5, + Format_L6 ); -- Common fields are: @@ -48,6 +50,12 @@ package body Elocations is -- Field2 : Location_Type -- Field3 : Location_Type + -- Fields of Format_L4: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Fields of Format_L5: -- Field1 : Location_Type -- Field2 : Location_Type @@ -55,6 +63,14 @@ package body Elocations is -- Field4 : Location_Type -- Field5 : Location_Type + -- Fields of Format_L6: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + -- Field6 : Location_Type + function Get_Format (Kind : Iir_Kind) return Format_Type; type Location_Index_Type is new Types.Nat32; @@ -100,8 +116,12 @@ package body Elocations is Len := 2; when Format_L3 => Len := 3; + when Format_L4 => + Len := 4; when Format_L5 => Len := 5; + when Format_L6 => + Len := 6; end case; Idx := Elocations_Table.Last + 1; @@ -153,5 +173,8 @@ package body Elocations is function Get_Field5 is new Get_FieldX (5); procedure Set_Field5 is new Set_FieldX (5); + function Get_Field6 is new Get_FieldX (6); + procedure Set_Field6 is new Set_FieldX (6); + -- Subprograms end Elocations; diff --git a/src/vhdl/elocations.ads b/src/vhdl/elocations.ads index b71944b5b..629d6707f 100644 --- a/src/vhdl/elocations.ads +++ b/src/vhdl/elocations.ads @@ -88,11 +88,11 @@ package Elocations is -- Iir_Kind_Disconnection_Specification (None) - -- Iir_Kind_Block_Header (L5) + -- Iir_Kind_Block_Header (L6) -- - -- Get/Set_Generic_Location (Field4) + -- Get/Set_Generic_Location (Field5) -- - -- Get/Set_Port_Location (Field5) + -- Get/Set_Port_Location (Field6) -- -- Get/Set_Generic_Map_Location (Field3) -- @@ -116,24 +116,28 @@ package Elocations is -- Declarations -- ------------------- - -- Iir_Kind_Entity_Declaration (L5) + -- Iir_Kind_Entity_Declaration (L6) -- -- Get/Set_Start_Location (Field1) -- -- Get/Set_End_Location (Field2) -- - -- Get/Set_Generic_Location (Field4) + -- Get/Set_Generic_Location (Field5) -- - -- Get/Set_Port_Location (Field5) + -- Get/Set_Port_Location (Field6) -- -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) - -- Iir_Kind_Architecture_Body (L3) + -- Iir_Kind_Architecture_Body (L4) -- Get/Set_Start_Location (Field1) -- -- Get/Set_End_Location (Field2) -- -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) -- Iir_Kind_Configuration_Declaration (L2) -- Get/Set_Start_Location (Field1) @@ -142,7 +146,7 @@ package Elocations is -- Iir_Kind_Package_Header (L5) -- - -- Get/Set_Generic_Location (Field4) + -- Get/Set_Generic_Location (Field5) -- -- Get/Set_Generic_Map_Location (Field3) @@ -175,15 +179,15 @@ package Elocations is -- Iir_Kind_Library_Declaration (None) - -- Iir_Kind_Component_Declaration (L5) + -- Iir_Kind_Component_Declaration (L6) -- -- Get/Set_Start_Location (Field1) -- -- Get/Set_End_Location (Field2) -- - -- Get/Set_Generic_Location (Field4) + -- Get/Set_Generic_Location (Field5) -- - -- Get/Set_Port_Location (Field5) + -- Get/Set_Port_Location (Field6) -- Iir_Kind_Object_Alias_Declaration (L1) -- @@ -195,17 +199,17 @@ package Elocations is -- -- Get/Set_Start_Location (Field1) - -- Iir_Kind_Type_Declaration (L2) + -- Iir_Kind_Type_Declaration (L4) -- -- Get/Set_Start_Location (Field1) -- - -- Get/Set_Is_Location (Field2) + -- Get/Set_Is_Location (Field4) - -- Iir_Kind_Subtype_Declaration (L2) + -- Iir_Kind_Subtype_Declaration (L4) -- -- Get/Set_Start_Location (Field1) -- - -- Get/Set_Is_Location (Field2) + -- Get/Set_Is_Location (Field4) -- Iir_Kind_Nature_Declaration (None) @@ -231,14 +235,16 @@ package Elocations is -- -- Get/Set_Start_Location (Field1) - -- Iir_Kind_Function_Body (L3) - -- Iir_Kind_Procedure_Body (L3) + -- Iir_Kind_Function_Body (L4) + -- Iir_Kind_Procedure_Body (L4) -- -- Get/Set_Start_Location (Field1) -- -- Get/Set_End_Location (Field2) -- -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) -- Iir_Kind_Interface_Function_Declaration (None) -- Iir_Kind_Interface_Procedure_Declaration (None) @@ -377,14 +383,16 @@ package Elocations is -- -- Get/Set_Start_Location (Field1) - -- Iir_Kind_Sensitized_Process_Statement (L3) - -- Iir_Kind_Process_Statement (L3) + -- Iir_Kind_Sensitized_Process_Statement (L4) + -- Iir_Kind_Process_Statement (L4) -- -- Get/Set_Start_Location (Field1) -- -- Get/Set_End_Location (Field2) -- -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) -- Iir_Kind_Concurrent_Assertion_Statement (None) @@ -399,11 +407,13 @@ package Elocations is -- -- Get/Set_Port_Map_Location (Field2) - -- Iir_Kind_Block_Statement (L3) + -- Iir_Kind_Block_Statement (L4) -- -- Get/Set_End_Location (Field2) -- -- Get/Set_Begin_Location (Field3) + -- + -- Get/Set_Is_Location (Field4) -- Iir_Kind_Generate_Statement_Body (L3) -- @@ -631,7 +641,7 @@ package Elocations is function Get_End_Location (N : Iir) return Location_Type; procedure Set_End_Location (N : Iir; Loc : Location_Type); - -- Field: Field2 + -- Field: Field4 function Get_Is_Location (N : Iir) return Location_Type; procedure Set_Is_Location (N : Iir; Loc : Location_Type); @@ -651,11 +661,11 @@ package Elocations is function Get_Generate_Location (N : Iir) return Location_Type; procedure Set_Generate_Location (N : Iir; Loc : Location_Type); - -- Field: Field4 + -- Field: Field5 function Get_Generic_Location (N : Iir) return Location_Type; procedure Set_Generic_Location (N : Iir; Loc : Location_Type); - -- Field: Field5 + -- Field: Field6 function Get_Port_Location (N : Iir) return Location_Type; procedure Set_Port_Location (N : Iir; Loc : Location_Type); diff --git a/src/vhdl/elocations_meta.adb b/src/vhdl/elocations_meta.adb index bcac6d39e..fdc808429 100644 --- a/src/vhdl/elocations_meta.adb +++ b/src/vhdl/elocations_meta.adb @@ -233,7 +233,14 @@ package body Elocations_Meta is begin case K is when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration => + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement => return True; when others => return False; diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index e8c4abe14..f7985f6d4 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -2914,6 +2914,16 @@ package Iirs is -- Get/Set_Has_Component (Flag5) -- Iir_Kind_Block_Statement (Medium) + -- LRM08 11.2 Block statement + -- + -- block_statement ::= + -- block_label : + -- BLOCK [ ( guard_condition ) ] [ IS ] + -- block_header + -- block_declarative_part + -- BEGIN + -- block_statement_part + -- END BLOCK [ block_label ] ; -- -- Get/Set_Parent (Field0) -- diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 24e62e0d3..5bae26b22 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -4626,9 +4626,12 @@ package body Parse is Parse_Declarative_Part (Res); if Current_Token = Tok_Begin then + Begin_Loc := Get_Token_Location; Set_Has_Begin (Res, True); + + -- Skip 'begin'. Scan; - Begin_Loc := Get_Token_Location; + Parse_Concurrent_Statements (Res); else Begin_Loc := No_Location; @@ -4638,7 +4641,9 @@ package body Parse is Expect (Tok_End); End_Loc := Get_Token_Location; + -- Skip 'end'. Scan; + if Current_Token = Tok_Entity then if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("'entity' keyword not allowed here by vhdl 87"); @@ -6787,7 +6792,7 @@ package body Parse is Kind : Iir_Kind; Subprg: Iir; Subprg_Body : Iir; - Start_Loc, Begin_Loc, End_Loc : Location_Type; + Start_Loc, Is_Loc, Begin_Loc, End_Loc : Location_Type; begin -- Create the node. Start_Loc := Get_Token_Location; @@ -6863,6 +6868,7 @@ package body Parse is Set_Chain (Subprg, Subprg_Body); -- Skip 'is'. + Is_Loc := Get_Token_Location; Expect (Tok_Is); Scan; @@ -6883,6 +6889,7 @@ package body Parse is if Flag_Elocations then Create_Elocations (Subprg_Body); + Set_Is_Location (Subprg_Body, Is_Loc); Set_Begin_Location (Subprg_Body, Begin_Loc); Set_End_Location (Subprg_Body, End_Loc); end if; @@ -7497,6 +7504,10 @@ package body Parse is Set_Has_Label (Bod, Label /= Null_Identifier); End_Loc := No_Location; + if Flag_Elocations then + Create_Elocations (Bod); + end if; + -- Check for a block declarative item. case Current_Token is when @@ -7544,6 +7555,10 @@ package body Parse is Expect (Tok_Begin); Set_Has_Begin (Bod, True); + if Flag_Elocations then + Set_Begin_Location (Bod, Get_Token_Location); + end if; + -- Skip 'begin' Scan; when others => @@ -7565,6 +7580,10 @@ package body Parse is if Vhdl_Std >= Vhdl_08 and then Current_Token /= Tok_Generate then -- This is the 'end' of the generate_statement_body. Set_Has_End (Bod, True); + if Flag_Elocations then + Set_End_Location (Bod, End_Loc); + end if; + Check_End_Name (Label, Bod); Scan_Semi_Colon ("generate statement body"); |