From 41384788259c77d0057375cb93a0cfd67002ab52 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 25 Oct 2019 06:53:08 +0200 Subject: vhdl: extract sem_concurrent_statement, to handle hdl stmt in vunits. --- src/vhdl/vhdl-parse.adb | 51 ++++++------- src/vhdl/vhdl-sem_psl.adb | 5 ++ src/vhdl/vhdl-sem_stmts.adb | 181 +++++++++++++++++++++----------------------- src/vhdl/vhdl-sem_stmts.ads | 4 + 4 files changed, 122 insertions(+), 119 deletions(-) (limited to 'src') diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index 9a358fe0c..f46535623 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -8556,6 +8556,19 @@ package body Vhdl.Parse is end case; end Parse_Concurrent_Assignment; + function Parse_Concurrent_Assignment_With_Name + (Name : Name_Id; Loc : Location_Type) return Iir + is + Target : Iir; + begin + Target := Create_Iir (Iir_Kind_Simple_Name); + Set_Location (Target, Loc); + Set_Identifier (Target, Name); + Target := Parse_Name_Suffix (Target); + + return Parse_Concurrent_Assignment (Target); + end Parse_Concurrent_Assignment_With_Name; + -- Parse end of PSL assert/cover statement. procedure Parse_Psl_Assert_Report_Severity (Stmt : Iir; Flag_Psl : Boolean) is @@ -8728,13 +8741,8 @@ package body Vhdl.Parse is Scan; else -- This is not a label. Assume a concurrent assignment. - Target := Create_Iir (Iir_Kind_Simple_Name); - Set_Location (Target, Loc); - Set_Identifier (Target, Label); + Stmt := Parse_Concurrent_Assignment_With_Name (Label, Loc); Label := Null_Identifier; - Target := Parse_Name_Suffix (Target); - - Stmt := Parse_Concurrent_Assignment (Target); goto Has_Stmt; end if; end if; @@ -9782,7 +9790,7 @@ package body Vhdl.Parse is -- | restrive_guarantee_directive -- | cover_directive -- | fairness_directive - function Parse_Psl_Verification_Directive return Node is + function Parse_Psl_Directive_Or_Stmt return Node is begin case Current_Token is when Tok_Assume => @@ -9796,7 +9804,7 @@ package body Vhdl.Parse is when others => raise Internal_Error; end case; - end Parse_Psl_Verification_Directive; + end Parse_Psl_Directive_Or_Stmt; -- 1850-2005 7.2 Verification units -- verification_unit ::= @@ -9866,7 +9874,7 @@ package body Vhdl.Parse is | Tok_Assert | Tok_Restrict | Tok_Cover => - Item := Parse_Psl_Verification_Directive; + Item := Parse_Psl_Directive_Or_Stmt; when Tok_Type | Tok_Subtype | Tok_Signal @@ -9901,26 +9909,17 @@ package body Vhdl.Parse is -- Skip label. Scan; - if Current_Token /= Tok_Colon then - Error_Msg_Parse ("':' expected after label"); - else + if Current_Token = Tok_Colon then -- Skip ':'. Scan; - end if; - case Current_Token is - when Tok_Assume - | Tok_Assert - | Tok_Restrict - | Tok_Cover => - Item := Parse_Psl_Verification_Directive; - Set_Label (Item, Label); - Set_Location (Item, Loc); - when others => - Error_Msg_Parse - ("verification directive expected after label"); - Item := Null_Iir; - end case; + Item := Parse_Psl_Directive_Or_Stmt; + Set_Label (Item, Label); + Set_Location (Item, Loc); + else + Item := Parse_Concurrent_Assignment_With_Name + (Label, Loc); + end if; end; when others => exit; diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index 7bf1f1f6c..3843a3ff7 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -666,6 +666,9 @@ package body Vhdl.Sem_Psl is Set_Severity_Expression (Res, Get_Severity_Expression (Stmt)); Set_Report_Expression (Res, Get_Report_Expression (Stmt)); Set_Postponed_Flag (Res, Get_Postponed_Flag (Stmt)); + + Set_Parent (Res, Get_Parent (Stmt)); + Set_Chain (Res, Get_Chain (Stmt)); return Res; end Rewrite_As_Concurrent_Assertion; @@ -1010,6 +1013,8 @@ package body Vhdl.Sem_Psl is | Iir_Kind_Procedure_Body => Sem_Decls.Sem_Declaration (Item, Prev_Item, False, Attr_Spec_Chain); + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + Sem_Stmts.Sem_Concurrent_Statement (Item, False); when others => Error_Kind ("sem_psl_verification_unit", Item); end case; diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index 70035c321..35d49fc33 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -1619,6 +1619,7 @@ package body Vhdl.Sem_Stmts is Label := Get_Label (Stmt); Set_Label (N_Stmt, Label); Set_Parent (N_Stmt, Get_Parent (Stmt)); + Set_Chain (N_Stmt, Get_Chain (Stmt)); Set_Instantiated_Unit (N_Stmt, Finish_Sem_Name (Imp)); Location_Copy (N_Stmt, Stmt); @@ -1964,113 +1965,107 @@ package body Vhdl.Sem_Stmts is -- FIXME: check for nature type... end Simple_Simultaneous_Statement; - procedure Sem_Concurrent_Statement_Chain (Parent : Iir) + procedure Sem_Concurrent_Statement (Stmt : in out Iir; Is_Passive : Boolean) is - Is_Passive : constant Boolean := - Get_Kind (Parent) = Iir_Kind_Entity_Declaration; - El: Iir; - New_El : Iir; - Next_El : Iir; + Prev_Concurrent_Statement : constant Iir := Current_Concurrent_Statement; procedure No_Generate_Statement is begin if Is_Passive then - Error_Msg_Sem (+El, "generate statement forbidden in entity"); + Error_Msg_Sem (+Stmt, "generate statement forbidden in entity"); end if; end No_Generate_Statement; - - Prev_El : Iir; - Prev_Concurrent_Statement : Iir; begin - Prev_Concurrent_Statement := Current_Concurrent_Statement; + Current_Concurrent_Statement := Stmt; - El := Get_Concurrent_Statement_Chain (Parent); - Prev_El := Null_Iir; - while El /= Null_Iir loop - Current_Concurrent_Statement := El; - New_El := El; - Next_El := Get_Chain (El); + case Get_Kind (Stmt) is + when Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment => + if Is_Passive then + Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity"); + end if; + Sem_Signal_Assignment (Stmt); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + if Is_Passive then + Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity"); + end if; + Sem_Concurrent_Selected_Signal_Assignment (Stmt); + when Iir_Kind_Sensitized_Process_Statement => + Set_Passive_Flag (Stmt, Is_Passive); + Sem_Sensitized_Process_Statement (Stmt); + when Iir_Kind_Process_Statement => + Set_Passive_Flag (Stmt, Is_Passive); + Sem_Process_Statement (Stmt); + when Iir_Kind_Component_Instantiation_Statement => + Sem_Component_Instantiation_Statement (Stmt, Is_Passive); + when Iir_Kind_Concurrent_Assertion_Statement => + -- FIXME: must check assertion expressions does not contain + -- non-passive subprograms ?? + Sem_Assertion_Statement (Stmt); + when Iir_Kind_Block_Statement => + if Is_Passive then + Error_Msg_Sem (+Stmt, "block forbidden in entity"); + end if; + Sem_Block_Statement (Stmt); + when Iir_Kind_If_Generate_Statement => + No_Generate_Statement; + Sem_If_Generate_Statement (Stmt); + when Iir_Kind_For_Generate_Statement => + No_Generate_Statement; + Sem_For_Generate_Statement (Stmt); + when Iir_Kind_Case_Generate_Statement => + No_Generate_Statement; + Sem_Case_Generate_Statement (Stmt); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Stmt := + Sem_Concurrent_Procedure_Call_Statement (Stmt, Is_Passive); + when Iir_Kind_Psl_Declaration => + Sem_Psl.Sem_Psl_Declaration (Stmt); + when Iir_Kind_Psl_Endpoint_Declaration => + Sem_Psl.Sem_Psl_Endpoint_Declaration (Stmt); + when Iir_Kind_Psl_Assert_Directive => + Stmt := Sem_Psl.Sem_Psl_Assert_Directive (Stmt, True); + when Iir_Kind_Psl_Assume_Directive => + Sem_Psl.Sem_Psl_Assume_Directive (Stmt); + when Iir_Kind_Psl_Cover_Directive => + Sem_Psl.Sem_Psl_Cover_Directive (Stmt); + when Iir_Kind_Psl_Restrict_Directive => + Sem_Psl.Sem_Psl_Restrict_Directive (Stmt); + when Iir_Kind_Psl_Default_Clock => + Sem_Psl.Sem_Psl_Default_Clock (Stmt); + when Iir_Kind_Simple_Simultaneous_Statement => + Simple_Simultaneous_Statement (Stmt); + when others => + Error_Kind ("sem_concurrent_statement", Stmt); + end case; - case Get_Kind (El) is - when Iir_Kind_Concurrent_Simple_Signal_Assignment - | Iir_Kind_Concurrent_Conditional_Signal_Assignment => - if Is_Passive then - Error_Msg_Sem (+El, "signal assignment forbidden in entity"); - end if; - Sem_Signal_Assignment (El); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - if Is_Passive then - Error_Msg_Sem (+El, "signal assignment forbidden in entity"); - end if; - Sem_Concurrent_Selected_Signal_Assignment (El); - when Iir_Kind_Sensitized_Process_Statement => - Set_Passive_Flag (El, Is_Passive); - Sem_Sensitized_Process_Statement (El); - when Iir_Kind_Process_Statement => - Set_Passive_Flag (El, Is_Passive); - Sem_Process_Statement (El); - when Iir_Kind_Component_Instantiation_Statement => - Sem_Component_Instantiation_Statement (El, Is_Passive); - when Iir_Kind_Concurrent_Assertion_Statement => - -- FIXME: must check assertion expressions does not contain - -- non-passive subprograms ?? - Sem_Assertion_Statement (El); - when Iir_Kind_Block_Statement => - if Is_Passive then - Error_Msg_Sem (+El, "block forbidden in entity"); - end if; - Sem_Block_Statement (El); - when Iir_Kind_If_Generate_Statement => - No_Generate_Statement; - Sem_If_Generate_Statement (El); - when Iir_Kind_For_Generate_Statement => - No_Generate_Statement; - Sem_For_Generate_Statement (El); - when Iir_Kind_Case_Generate_Statement => - No_Generate_Statement; - Sem_Case_Generate_Statement (El); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - New_El := Sem_Concurrent_Procedure_Call_Statement - (El, Is_Passive); - when Iir_Kind_Psl_Declaration => - Sem_Psl.Sem_Psl_Declaration (El); - when Iir_Kind_Psl_Endpoint_Declaration => - Sem_Psl.Sem_Psl_Endpoint_Declaration (El); - when Iir_Kind_Psl_Assert_Directive => - New_El := Sem_Psl.Sem_Psl_Assert_Directive (El, True); - when Iir_Kind_Psl_Assume_Directive => - Sem_Psl.Sem_Psl_Assume_Directive (El); - when Iir_Kind_Psl_Cover_Directive => - Sem_Psl.Sem_Psl_Cover_Directive (El); - when Iir_Kind_Psl_Restrict_Directive => - Sem_Psl.Sem_Psl_Restrict_Directive (El); - when Iir_Kind_Psl_Default_Clock => - Sem_Psl.Sem_Psl_Default_Clock (El); - when Iir_Kind_Simple_Simultaneous_Statement => - Simple_Simultaneous_Statement (El); - when others => - Error_Kind ("sem_concurrent_statement_chain", El); - end case; + Current_Concurrent_Statement := Prev_Concurrent_Statement; + end Sem_Concurrent_Statement; - if New_El /= El then - -- Replace this node. - if Prev_El = Null_Iir then - Set_Concurrent_Statement_Chain (Parent, New_El); - else - Set_Chain (Prev_El, New_El); - end if; - Set_Chain (New_El, Next_El); - Set_Parent (New_El, Parent); - Prev_El := New_El; + procedure Sem_Concurrent_Statement_Chain (Parent : Iir) + is + Is_Passive : constant Boolean := + Get_Kind (Parent) = Iir_Kind_Entity_Declaration; + + Stmt : Iir; + Prev_Stmt : Iir; + begin + Stmt := Get_Concurrent_Statement_Chain (Parent); + Prev_Stmt := Null_Iir; + while Stmt /= Null_Iir loop + Sem_Concurrent_Statement (Stmt, Is_Passive); + + pragma Assert (Get_Parent (Stmt) = Parent); + + -- Replace this node. + if Prev_Stmt = Null_Iir then + Set_Concurrent_Statement_Chain (Parent, Stmt); else - Prev_El := El; - pragma Assert (Get_Parent (El) = Parent); + Set_Chain (Prev_Stmt, Stmt); end if; - - El := Next_El; + Prev_Stmt := Stmt; + Stmt := Get_Chain (Stmt); end loop; - - Current_Concurrent_Statement := Prev_Concurrent_Statement; end Sem_Concurrent_Statement_Chain; -- Put labels in declarative region. diff --git a/src/vhdl/vhdl-sem_stmts.ads b/src/vhdl/vhdl-sem_stmts.ads index 484727c0d..3d2632438 100644 --- a/src/vhdl/vhdl-sem_stmts.ads +++ b/src/vhdl/vhdl-sem_stmts.ads @@ -23,6 +23,10 @@ package Vhdl.Sem_Stmts is -- a block_statement or a generate_statement_body. procedure Sem_Block (Blk: Iir); + -- Analyze concurrent statement STMT. Used only by PSL. + procedure Sem_Concurrent_Statement + (Stmt : in out Iir; Is_Passive : Boolean); + -- Analyze the concurrent statements of PARENT. procedure Sem_Concurrent_Statement_Chain (Parent : Iir); -- cgit v1.2.3