From 481c0b8d4a1045cbe192698055ff9d200d048079 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 12 Jan 2017 08:04:21 +0100 Subject: vhdl08: allow PSL default clock declaration in block declarative parts. --- src/vhdl/canon.adb | 4 + src/vhdl/parse.adb | 151 +++++++++++++++++++++---------------- src/vhdl/sem.adb | 4 +- src/vhdl/sem_decls.adb | 7 ++ src/vhdl/sem_stmts.adb | 28 +++---- src/vhdl/sem_stmts.ads | 7 +- src/vhdl/translate/trans-chap4.adb | 10 +++ src/vhdl/translate/trans-rtis.adb | 5 ++ 8 files changed, 131 insertions(+), 85 deletions(-) diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index a444ab12c..8f23bf2d9 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -2784,6 +2784,10 @@ package body Canon is null; when Iir_Kinds_Quantity_Declaration => null; + + when Iir_Kind_Psl_Default_Clock => + null; + when others => Error_Kind ("canon_declaration", Decl); end case; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 31af2556d..2dc07d326 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -3879,6 +3879,64 @@ package body Parse is return Res; end Parse_Disconnection_Specification; + function Parse_Psl_Default_Clock return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Psl_Default_Clock); + Set_Location (Res); + Scanner.Flag_Psl := True; + Scan_Expect (Tok_Psl_Clock); + Scan_Expect (Tok_Is); + Scan; + Set_Psl_Boolean (Res, Parse_Psl.Parse_Psl_Boolean); + Expect (Tok_Semi_Colon); + Scanner.Flag_Scan_In_Comment := False; + Scanner.Flag_Psl := False; + return Res; + end Parse_Psl_Default_Clock; + + function Parse_Psl_Declaration return Iir + is + Tok : constant Token_Type := Current_Token; + Loc : constant Location_Type := Get_Token_Location; + Res : Iir; + Decl : PSL_Node; + Id : Name_Id; + begin + -- Skip 'property', 'sequence' or 'endpoint'. + Scan; + + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("declaration name expected here"); + Id := Null_Identifier; + else + Id := Current_Identifier; + end if; + + -- Parse PSL declaration. + Scanner.Flag_Psl := True; + Decl := Parse_Psl.Parse_Psl_Declaration (Tok); + Expect (Tok_Semi_Colon); + Scanner.Flag_Scan_In_Comment := False; + Scanner.Flag_Psl := False; + + if Tok = Tok_Psl_Endpoint + and then Parse_Psl.Is_Instantiated_Declaration (Decl) + then + -- Instantiated endpoint: make it visible from VHDL. + Res := Create_Iir (Iir_Kind_Psl_Endpoint_Declaration); + else + -- Otherwise, it will be visible only from PSL. + Res := Create_Iir (Iir_Kind_Psl_Declaration); + end if; + Set_Location (Res, Loc); + Set_Identifier (Res, Id); + Set_Psl_Declaration (Res, Decl); + + return Res; + end Parse_Psl_Declaration; + -- Return the parent of a nested package. Used to check if some -- declarations are allowed in a package. function Get_Package_Parent (Decl : Iir) return Iir @@ -4092,8 +4150,8 @@ package body Parse is -- -- Declarations for protected_type_declaration are handled in sem. -- - -- (*: block means block_declarative_item, ie: block_statement, - -- architecture_body and generate_statement) + -- (*): block means block_declarative_item, ie: block_statement, + -- architecture_body and generate_statement) procedure Parse_Declarative_Part (Parent : Iir) is use Declaration_Chain_Handling; @@ -4334,7 +4392,7 @@ package body Parse is | Iir_Kind_Package_Declaration => null; when others => - Error_Kind ("parse_declarative_part", Package_Parent); + Error_Kind ("parse_declarative_part", Parent); end case; Decl := Parse_Disconnection_Specification; when Tok_Use => @@ -4356,9 +4414,33 @@ package body Parse is end if; end if; when Tok_Identifier => - Error_Msg_Parse - ("object class keyword such as 'variable' is expected"); - Eat_Tokens_Until_Semi_Colon; + if Vhdl_Std >= Vhdl_08 + and then Current_Identifier = Name_Default + then + case Get_Kind (Parent) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kinds_Process_Statement + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Protected_Type_Declaration => + Error_Msg_Parse + ("PSL default clock declaration not allowed here"); + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement_Body => + null; + when others => + Error_Kind ("parse_declarative_part", Parent); + end case; + Decl := Parse_Psl_Default_Clock; + else + Error_Msg_Parse + ("object class keyword such as 'variable' is expected"); + Eat_Tokens_Until_Semi_Colon; + end if; when Tok_Semi_Colon => Error_Msg_Parse ("';' (semi colon) not allowed alone"); Scan; @@ -7547,63 +7629,6 @@ package body Parse is end case; end Parse_Concurrent_Assignment; - function Parse_Psl_Default_Clock return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Psl_Default_Clock); - Scanner.Flag_Psl := True; - Scan_Expect (Tok_Psl_Clock); - Scan_Expect (Tok_Is); - Scan; - Set_Psl_Boolean (Res, Parse_Psl.Parse_Psl_Boolean); - Expect (Tok_Semi_Colon); - Scanner.Flag_Scan_In_Comment := False; - Scanner.Flag_Psl := False; - return Res; - end Parse_Psl_Default_Clock; - - function Parse_Psl_Declaration return Iir - is - Tok : constant Token_Type := Current_Token; - Loc : constant Location_Type := Get_Token_Location; - Res : Iir; - Decl : PSL_Node; - Id : Name_Id; - begin - -- Skip 'property', 'sequence' or 'endpoint'. - Scan; - - if Current_Token /= Tok_Identifier then - Error_Msg_Parse ("declaration name expected here"); - Id := Null_Identifier; - else - Id := Current_Identifier; - end if; - - -- Parse PSL declaration. - Scanner.Flag_Psl := True; - Decl := Parse_Psl.Parse_Psl_Declaration (Tok); - Expect (Tok_Semi_Colon); - Scanner.Flag_Scan_In_Comment := False; - Scanner.Flag_Psl := False; - - if Tok = Tok_Psl_Endpoint - and then Parse_Psl.Is_Instantiated_Declaration (Decl) - then - -- Instantiated endpoint: make it visible from VHDL. - Res := Create_Iir (Iir_Kind_Psl_Endpoint_Declaration); - else - -- Otherwise, it will be visible only from PSL. - Res := Create_Iir (Iir_Kind_Psl_Declaration); - end if; - Set_Location (Res, Loc); - Set_Identifier (Res, Id); - Set_Psl_Declaration (Res, Decl); - - return Res; - end Parse_Psl_Declaration; - -- Parse end of PSL assert/cover statement. procedure Parse_Psl_Assert_Report_Severity (Stmt : Iir) is begin diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index ba6eaf481..a213ceee2 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -77,7 +77,7 @@ package body Sem is Sem_Interface_Chain (Get_Port_Chain (Entity), Port_Interface_List); -- Entity declarative part and concurrent statements. - Sem_Block (Entity, True); + Sem_Block (Entity); Close_Declarative_Region; Set_Is_Within_Flag (Entity, False); @@ -201,7 +201,7 @@ package body Sem is if Vhdl_Std >= Vhdl_02 then Open_Declarative_Region; end if; - Sem_Block (Arch, True); + Sem_Block (Arch); if Vhdl_Std >= Vhdl_02 then Close_Declarative_Region; end if; diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index d021bee98..53daeb6fa 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -31,6 +31,7 @@ with Sem_Scopes; use Sem_Scopes; with Sem_Names; use Sem_Names; with Sem_Specs; use Sem_Specs; with Sem_Types; use Sem_Types; +with Sem_Psl; with Sem_Inst; with Xrefs; use Xrefs; use Iir_Chains; @@ -3056,6 +3057,12 @@ package body Sem_Decls is | Iir_Kind_Through_Quantity_Declaration => Sem_Branch_Quantity_Declaration (Decl, Last_Obj_Decl); Last_Obj_Decl := Decl; + + when Iir_Kind_Psl_Declaration => + Sem_Psl.Sem_Psl_Declaration (Decl); + when Iir_Kind_Psl_Default_Clock => + Sem_Psl.Sem_Psl_Default_Clock (Decl); + when others => Error_Kind ("sem_declaration_chain", Decl); end case; diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index d79e05d2b..f68040959 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -1666,7 +1666,7 @@ package body Sem_Stmts is Set_Visible_Flag (Guard, True); end if; - Sem_Block (Stmt, True); + Sem_Block (Stmt); Set_Is_Within_Flag (Stmt, False); Close_Declarative_Region; end Sem_Block_Statement; @@ -1674,7 +1674,7 @@ package body Sem_Stmts is procedure Sem_Generate_Statement_Body (Bod : Iir) is begin Set_Is_Within_Flag (Bod, True); - Sem_Block (Bod, True); -- Flags.Vhdl_Std /= Vhdl_87); + Sem_Block (Bod); Set_Is_Within_Flag (Bod, False); end Sem_Generate_Statement_Body; @@ -1918,10 +1918,8 @@ package body Sem_Stmts is Prev_El : Iir; Prev_Concurrent_Statement : Iir; - Prev_Psl_Default_Clock : Iir; begin Prev_Concurrent_Statement := Current_Concurrent_Statement; - Prev_Psl_Default_Clock := Current_Psl_Default_Clock; El := Get_Concurrent_Statement_Chain (Parent); Prev_El := Null_Iir; @@ -2006,7 +2004,6 @@ package body Sem_Stmts is end loop; Current_Concurrent_Statement := Prev_Concurrent_Statement; - Current_Psl_Default_Clock := Prev_Psl_Default_Clock; end Sem_Concurrent_Statement_Chain; -- Put labels in declarative region. @@ -2049,27 +2046,26 @@ package body Sem_Stmts is end loop; end Sem_Labels_Chain; - procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean) + procedure Sem_Block (Blk: Iir) is Implicit : Implicit_Signal_Declaration_Type; + Prev_Psl_Default_Clock : Iir; begin + Prev_Psl_Default_Clock := Current_Psl_Default_Clock; Push_Signals_Declarative_Part (Implicit, Blk); - if Sem_Decls then - Sem_Labels_Chain (Blk); - Sem_Declaration_Chain (Blk); - end if; + Sem_Labels_Chain (Blk); + Sem_Declaration_Chain (Blk); Sem_Concurrent_Statement_Chain (Blk); - if Sem_Decls then - -- FIXME: do it only if there is conf. spec. in the declarative - -- part. - Sem_Specification_Chain (Blk, Blk); - Check_Full_Declaration (Blk, Blk); - end if; + -- FIXME: do it only if there is conf. spec. in the declarative + -- part. + Sem_Specification_Chain (Blk, Blk); + Check_Full_Declaration (Blk, Blk); Pop_Signals_Declarative_Part (Implicit); + Current_Psl_Default_Clock := Prev_Psl_Default_Clock; end Sem_Block; -- Add a driver for SIG. diff --git a/src/vhdl/sem_stmts.ads b/src/vhdl/sem_stmts.ads index 8fbbef617..5df75e09c 100644 --- a/src/vhdl/sem_stmts.ads +++ b/src/vhdl/sem_stmts.ads @@ -19,10 +19,9 @@ with Iirs; use Iirs; package Sem_Stmts is -- Analyze declarations and concurrent statements of BLK, which is - -- either an architecture_declaration, and entity_declaration or - -- a block_statement. - -- If SEM_DECLS is true, then analyze the declarations of BLK. - procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean); + -- either an architecture_declaration, and entity_declaration, + -- a block_statement or a generate_statement_body. + procedure Sem_Block (Blk: Iir); -- Analyze the concurrent statements of PARENT. procedure Sem_Concurrent_Statement_Chain (Parent : Iir); diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 3a1cad573..32dc21136 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -1676,6 +1676,11 @@ package body Trans.Chap4 is when Iir_Kind_Disconnection_Specification => null; + when Iir_Kind_Psl_Default_Clock => + null; + when Iir_Kind_Psl_Declaration => + null; + when Iir_Kind_Component_Declaration => Chap4.Translate_Component_Declaration (Decl); when Iir_Kind_Type_Declaration => @@ -2516,6 +2521,11 @@ package body Trans.Chap4 is -- FIXME: finalizers ? Chap2.Elab_Package_Instantiation_Declaration (Decl); + when Iir_Kind_Psl_Default_Clock => + null; + when Iir_Kind_Psl_Declaration => + null; + when others => Error_Kind ("elab_declaration_chain", Decl); end case; diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 8b191f31b..96abfc206 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -2331,6 +2331,11 @@ package body Trans.Rtis is -- FIXME: todo null; + when Iir_Kind_Psl_Default_Clock => + null; + when Iir_Kind_Psl_Declaration => + null; + when others => Error_Kind ("rti.generate_declaration_chain", Decl); end case; -- cgit v1.2.3