vhdl08: allow PSL default clock declaration in block declarative parts.

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;