vhdl: extract sem_concurrent_statement, to handle hdl stmt in vunits.

4 files changed, 122 insertions, 119 deletions

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);