ams-vhdl: analyze, canon and print simultaneous procedural statements.

6 files changed, 175 insertions, 90 deletions

diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index 95fe700d4..98d69901c 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -2278,6 +2278,17 @@ package body Vhdl.Canon is
                   Clause := Get_Else_Clause (Clause);
                end loop;
             end;
+         when Iir_Kind_Simultaneous_Procedural_Statement =>
+            Canon_Declarations (Top, Stmt, Null_Iir);
+            if Canon_Flag_Sequentials_Stmts then
+               declare
+                  Stmts : Iir;
+               begin
+                  Stmts := Get_Sequential_Statement_Chain (Stmt);
+                  Stmts := Canon_Sequential_Stmts (Stmts);
+                  Set_Sequential_Statement_Chain (Stmt, Stmts);
+               end;
+            end if;
 
          when others =>
             Error_Kind ("canon_concurrent_statement", Stmt);
diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads
index 799215b9e..dd90d12d1 100644
--- a/src/vhdl/vhdl-nodes.ads
+++ b/src/vhdl/vhdl-nodes.ads
@@ -3501,16 +3501,21 @@ package Vhdl.Nodes is
    --
    --   Get/Set_Parent (Field0)
    --
-   --   Get/Set_Declaration_Chain (Field1)
+   --   Get/Set_Chain (Field2)
    --
    --   Get/Set_Label (Field3)
-   --
    --   Get/Set_Identifier (Alias Field3)
    --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
    --   Get/Set_Attribute_Value_Chain (Field4)
    --
    --   Get/Set_Sequential_Statement_Chain (Field5)
    --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
    --   Get/Set_Has_Is (Flag7)
    --
    --   Get/Set_End_Has_Reserved_Id (Flag8)
diff --git a/src/vhdl/vhdl-nodes_meta.adb b/src/vhdl/vhdl-nodes_meta.adb
index cd519de46..de6b46488 100644
--- a/src/vhdl/vhdl-nodes_meta.adb
+++ b/src/vhdl/vhdl-nodes_meta.adb
@@ -4339,10 +4339,13 @@ package body Vhdl.Nodes_Meta is
       Field_Tolerance,
       --  Iir_Kind_Simultaneous_Procedural_Statement
       Field_Label,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
       Field_Has_Is,
       Field_End_Has_Reserved_Id,
       Field_End_Has_Identifier,
       Field_Parent,
+      Field_Chain,
       Field_Declaration_Chain,
       Field_Attribute_Value_Chain,
       Field_Sequential_Statement_Chain,
@@ -5191,92 +5194,92 @@ package body Vhdl.Nodes_Meta is
       Iir_Kind_Generate_Statement_Body => 1680,
       Iir_Kind_If_Generate_Else_Clause => 1686,
       Iir_Kind_Simple_Simultaneous_Statement => 1693,
-      Iir_Kind_Simultaneous_Procedural_Statement => 1701,
-      Iir_Kind_Simultaneous_If_Statement => 1710,
-      Iir_Kind_Simultaneous_Elsif => 1716,
-      Iir_Kind_Simple_Signal_Assignment_Statement => 1727,
-      Iir_Kind_Conditional_Signal_Assignment_Statement => 1738,
-      Iir_Kind_Selected_Waveform_Assignment_Statement => 1750,
-      Iir_Kind_Null_Statement => 1754,
-      Iir_Kind_Assertion_Statement => 1761,
-      Iir_Kind_Report_Statement => 1767,
-      Iir_Kind_Wait_Statement => 1775,
-      Iir_Kind_Variable_Assignment_Statement => 1782,
-      Iir_Kind_Conditional_Variable_Assignment_Statement => 1789,
-      Iir_Kind_Return_Statement => 1795,
-      Iir_Kind_For_Loop_Statement => 1806,
-      Iir_Kind_While_Loop_Statement => 1817,
-      Iir_Kind_Next_Statement => 1824,
-      Iir_Kind_Exit_Statement => 1831,
-      Iir_Kind_Case_Statement => 1839,
-      Iir_Kind_Procedure_Call_Statement => 1845,
-      Iir_Kind_Break_Statement => 1852,
-      Iir_Kind_If_Statement => 1862,
-      Iir_Kind_Elsif => 1868,
-      Iir_Kind_Character_Literal => 1876,
-      Iir_Kind_Simple_Name => 1884,
-      Iir_Kind_Selected_Name => 1893,
-      Iir_Kind_Operator_Symbol => 1899,
-      Iir_Kind_Reference_Name => 1904,
-      Iir_Kind_External_Constant_Name => 1912,
-      Iir_Kind_External_Signal_Name => 1920,
-      Iir_Kind_External_Variable_Name => 1929,
-      Iir_Kind_Selected_By_All_Name => 1935,
-      Iir_Kind_Parenthesis_Name => 1940,
-      Iir_Kind_Package_Pathname => 1944,
-      Iir_Kind_Absolute_Pathname => 1945,
-      Iir_Kind_Relative_Pathname => 1946,
-      Iir_Kind_Pathname_Element => 1951,
-      Iir_Kind_Base_Attribute => 1953,
-      Iir_Kind_Subtype_Attribute => 1958,
-      Iir_Kind_Element_Attribute => 1963,
-      Iir_Kind_Across_Attribute => 1968,
-      Iir_Kind_Through_Attribute => 1973,
-      Iir_Kind_Nature_Reference_Attribute => 1977,
-      Iir_Kind_Left_Type_Attribute => 1982,
-      Iir_Kind_Right_Type_Attribute => 1987,
-      Iir_Kind_High_Type_Attribute => 1992,
-      Iir_Kind_Low_Type_Attribute => 1997,
-      Iir_Kind_Ascending_Type_Attribute => 2002,
-      Iir_Kind_Image_Attribute => 2008,
-      Iir_Kind_Value_Attribute => 2014,
-      Iir_Kind_Pos_Attribute => 2020,
-      Iir_Kind_Val_Attribute => 2026,
-      Iir_Kind_Succ_Attribute => 2032,
-      Iir_Kind_Pred_Attribute => 2038,
-      Iir_Kind_Leftof_Attribute => 2044,
-      Iir_Kind_Rightof_Attribute => 2050,
-      Iir_Kind_Signal_Slew_Attribute => 2058,
-      Iir_Kind_Quantity_Slew_Attribute => 2066,
-      Iir_Kind_Ramp_Attribute => 2074,
-      Iir_Kind_Dot_Attribute => 2081,
-      Iir_Kind_Integ_Attribute => 2088,
-      Iir_Kind_Above_Attribute => 2096,
-      Iir_Kind_Delayed_Attribute => 2105,
-      Iir_Kind_Stable_Attribute => 2114,
-      Iir_Kind_Quiet_Attribute => 2123,
-      Iir_Kind_Transaction_Attribute => 2132,
-      Iir_Kind_Event_Attribute => 2136,
-      Iir_Kind_Active_Attribute => 2140,
-      Iir_Kind_Last_Event_Attribute => 2144,
-      Iir_Kind_Last_Active_Attribute => 2148,
-      Iir_Kind_Last_Value_Attribute => 2152,
-      Iir_Kind_Driving_Attribute => 2156,
-      Iir_Kind_Driving_Value_Attribute => 2160,
-      Iir_Kind_Behavior_Attribute => 2160,
-      Iir_Kind_Structure_Attribute => 2160,
-      Iir_Kind_Simple_Name_Attribute => 2167,
-      Iir_Kind_Instance_Name_Attribute => 2172,
-      Iir_Kind_Path_Name_Attribute => 2177,
-      Iir_Kind_Left_Array_Attribute => 2184,
-      Iir_Kind_Right_Array_Attribute => 2191,
-      Iir_Kind_High_Array_Attribute => 2198,
-      Iir_Kind_Low_Array_Attribute => 2205,
-      Iir_Kind_Length_Array_Attribute => 2212,
-      Iir_Kind_Ascending_Array_Attribute => 2219,
-      Iir_Kind_Range_Array_Attribute => 2226,
-      Iir_Kind_Reverse_Range_Array_Attribute => 2233,
-      Iir_Kind_Attribute_Name => 2242
+      Iir_Kind_Simultaneous_Procedural_Statement => 1704,
+      Iir_Kind_Simultaneous_If_Statement => 1713,
+      Iir_Kind_Simultaneous_Elsif => 1719,
+      Iir_Kind_Simple_Signal_Assignment_Statement => 1730,
+      Iir_Kind_Conditional_Signal_Assignment_Statement => 1741,
+      Iir_Kind_Selected_Waveform_Assignment_Statement => 1753,
+      Iir_Kind_Null_Statement => 1757,
+      Iir_Kind_Assertion_Statement => 1764,
+      Iir_Kind_Report_Statement => 1770,
+      Iir_Kind_Wait_Statement => 1778,
+      Iir_Kind_Variable_Assignment_Statement => 1785,
+      Iir_Kind_Conditional_Variable_Assignment_Statement => 1792,
+      Iir_Kind_Return_Statement => 1798,
+      Iir_Kind_For_Loop_Statement => 1809,
+      Iir_Kind_While_Loop_Statement => 1820,
+      Iir_Kind_Next_Statement => 1827,
+      Iir_Kind_Exit_Statement => 1834,
+      Iir_Kind_Case_Statement => 1842,
+      Iir_Kind_Procedure_Call_Statement => 1848,
+      Iir_Kind_Break_Statement => 1855,
+      Iir_Kind_If_Statement => 1865,
+      Iir_Kind_Elsif => 1871,
+      Iir_Kind_Character_Literal => 1879,
+      Iir_Kind_Simple_Name => 1887,
+      Iir_Kind_Selected_Name => 1896,
+      Iir_Kind_Operator_Symbol => 1902,
+      Iir_Kind_Reference_Name => 1907,
+      Iir_Kind_External_Constant_Name => 1915,
+      Iir_Kind_External_Signal_Name => 1923,
+      Iir_Kind_External_Variable_Name => 1932,
+      Iir_Kind_Selected_By_All_Name => 1938,
+      Iir_Kind_Parenthesis_Name => 1943,
+      Iir_Kind_Package_Pathname => 1947,
+      Iir_Kind_Absolute_Pathname => 1948,
+      Iir_Kind_Relative_Pathname => 1949,
+      Iir_Kind_Pathname_Element => 1954,
+      Iir_Kind_Base_Attribute => 1956,
+      Iir_Kind_Subtype_Attribute => 1961,
+      Iir_Kind_Element_Attribute => 1966,
+      Iir_Kind_Across_Attribute => 1971,
+      Iir_Kind_Through_Attribute => 1976,
+      Iir_Kind_Nature_Reference_Attribute => 1980,
+      Iir_Kind_Left_Type_Attribute => 1985,
+      Iir_Kind_Right_Type_Attribute => 1990,
+      Iir_Kind_High_Type_Attribute => 1995,
+      Iir_Kind_Low_Type_Attribute => 2000,
+      Iir_Kind_Ascending_Type_Attribute => 2005,
+      Iir_Kind_Image_Attribute => 2011,
+      Iir_Kind_Value_Attribute => 2017,
+      Iir_Kind_Pos_Attribute => 2023,
+      Iir_Kind_Val_Attribute => 2029,
+      Iir_Kind_Succ_Attribute => 2035,
+      Iir_Kind_Pred_Attribute => 2041,
+      Iir_Kind_Leftof_Attribute => 2047,
+      Iir_Kind_Rightof_Attribute => 2053,
+      Iir_Kind_Signal_Slew_Attribute => 2061,
+      Iir_Kind_Quantity_Slew_Attribute => 2069,
+      Iir_Kind_Ramp_Attribute => 2077,
+      Iir_Kind_Dot_Attribute => 2084,
+      Iir_Kind_Integ_Attribute => 2091,
+      Iir_Kind_Above_Attribute => 2099,
+      Iir_Kind_Delayed_Attribute => 2108,
+      Iir_Kind_Stable_Attribute => 2117,
+      Iir_Kind_Quiet_Attribute => 2126,
+      Iir_Kind_Transaction_Attribute => 2135,
+      Iir_Kind_Event_Attribute => 2139,
+      Iir_Kind_Active_Attribute => 2143,
+      Iir_Kind_Last_Event_Attribute => 2147,
+      Iir_Kind_Last_Active_Attribute => 2151,
+      Iir_Kind_Last_Value_Attribute => 2155,
+      Iir_Kind_Driving_Attribute => 2159,
+      Iir_Kind_Driving_Value_Attribute => 2163,
+      Iir_Kind_Behavior_Attribute => 2163,
+      Iir_Kind_Structure_Attribute => 2163,
+      Iir_Kind_Simple_Name_Attribute => 2170,
+      Iir_Kind_Instance_Name_Attribute => 2175,
+      Iir_Kind_Path_Name_Attribute => 2180,
+      Iir_Kind_Left_Array_Attribute => 2187,
+      Iir_Kind_Right_Array_Attribute => 2194,
+      Iir_Kind_High_Array_Attribute => 2201,
+      Iir_Kind_Low_Array_Attribute => 2208,
+      Iir_Kind_Length_Array_Attribute => 2215,
+      Iir_Kind_Ascending_Array_Attribute => 2222,
+      Iir_Kind_Range_Array_Attribute => 2229,
+      Iir_Kind_Reverse_Range_Array_Attribute => 2236,
+      Iir_Kind_Attribute_Name => 2245
      );
 
    function Get_Fields_First (K : Iir_Kind) return Fields_Index is
@@ -8135,6 +8138,7 @@ package body Vhdl.Nodes_Meta is
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Psl_Default_Clock
            | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Simultaneous_Procedural_Statement
            | Iir_Kind_Simultaneous_If_Statement
            | Iir_Kind_Simple_Signal_Assignment_Statement
            | Iir_Kind_Conditional_Signal_Assignment_Statement
@@ -9144,6 +9148,7 @@ package body Vhdl.Nodes_Meta is
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_If_Generate_Else_Clause
            | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Simultaneous_Procedural_Statement
            | Iir_Kind_Simultaneous_If_Statement
            | Iir_Kind_Simple_Signal_Assignment_Statement
            | Iir_Kind_Conditional_Signal_Assignment_Statement
@@ -11509,6 +11514,7 @@ package body Vhdl.Nodes_Meta is
            | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_For_Generate_Statement
            | Iir_Kind_Generate_Statement_Body
+           | Iir_Kind_Simultaneous_Procedural_Statement
            | Iir_Kind_For_Loop_Statement =>
             return True;
          when others =>
diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index 690a971bb..47afb99c3 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -284,7 +284,8 @@ package body Vhdl.Prints is
          when Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_Case_Generate_Statement
-           | Iir_Kind_For_Generate_Statement =>
+           | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Simultaneous_Procedural_Statement =>
             Disp_Ident (Ctxt, Get_Label (Decl));
          when Iir_Kind_Package_Body =>
             Disp_Identifier (Ctxt, Decl);
@@ -3942,6 +3943,38 @@ package body Vhdl.Prints is
       Close_Hbox (Ctxt);
    end Disp_Simple_Simultaneous_Statement;
 
+   procedure Disp_Simultaneous_Procedural_Statement
+     (Ctxt : in out Ctxt_Class; Stmt : Iir) is
+   begin
+      Start_Hbox (Ctxt);
+      Disp_Label (Ctxt, Stmt);
+
+      Disp_Token (Ctxt, Tok_Procedural);
+      if Get_Has_Is (Stmt) then
+         Disp_Token (Ctxt, Tok_Is);
+      end if;
+      Close_Hbox (Ctxt);
+
+      Start_Vbox (Ctxt);
+      Disp_Declaration_Chain (Ctxt, Stmt);
+      Close_Vbox (Ctxt);
+
+      Start_Hbox (Ctxt);
+      Disp_Token (Ctxt, Tok_Begin);
+      Close_Hbox (Ctxt);
+
+      Start_Vbox (Ctxt);
+      Disp_Sequential_Statements
+        (Ctxt, Get_Sequential_Statement_Chain (Stmt));
+      Close_Vbox (Ctxt);
+
+      Start_Hbox (Ctxt);
+      Disp_Token (Ctxt, Tok_End);
+      Disp_After_End (Ctxt, Stmt, Tok_Procedural);
+      Disp_Token (Ctxt, Tok_Semi_Colon);
+      Close_Hbox (Ctxt);
+   end Disp_Simultaneous_Procedural_Statement;
+
    procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is
    begin
       case Get_Kind (Stmt) is
@@ -3987,6 +4020,8 @@ package body Vhdl.Prints is
             Disp_Simple_Simultaneous_Statement (Ctxt, Stmt);
          when Iir_Kind_Simultaneous_If_Statement =>
             Disp_Simultaneous_If_Statement (Ctxt, Stmt);
+         when Iir_Kind_Simultaneous_Procedural_Statement =>
+            Disp_Simultaneous_Procedural_Statement (Ctxt, Stmt);
          when others =>
             Error_Kind ("disp_concurrent_statement", Stmt);
       end case;
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb
index 6f7159656..10636bcb3 100644
--- a/src/vhdl/vhdl-sem_names.adb
+++ b/src/vhdl/vhdl-sem_names.adb
@@ -1524,7 +1524,8 @@ package body Vhdl.Sem_Names is
          return;
       end if;
       case Get_Kind (Subprg) is
-         when Iir_Kinds_Process_Statement =>
+         when Iir_Kinds_Process_Statement
+           | Iir_Kind_Simultaneous_Procedural_Statement =>
             return;
          when Iir_Kind_Procedure_Declaration =>
             --  Exit now if already known as impure.
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index e9b14a993..e1cb740b6 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -409,6 +409,14 @@ package body Vhdl.Sem_Stmts is
             --  An object designated by an access type is always an object of
             --  class variable.
             null;
+         when Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kinds_Branch_Quantity_Declaration
+           | Iir_Kind_Dot_Attribute =>
+            if (Get_Kind (Get_Parent (Stmt))
+                  /= Iir_Kind_Simultaneous_Procedural_Statement)
+            then
+               Error_Msg_Sem (+Stmt, "%n cannot be assigned", +Target_Prefix);
+            end if;
          when others =>
             Error_Msg_Sem (+Stmt, "%n is not a variable to be assigned",
                            +Target_Prefix);
@@ -2152,6 +2160,21 @@ package body Vhdl.Sem_Stmts is
       end loop;
    end Sem_Simultaneous_If_Statement;
 
+   procedure Sem_Simultaneous_Procedural_Statement (Stmt : Iir) is
+   begin
+      Set_Is_Within_Flag (Stmt, True);
+
+      --  AMS-LRM17 12.1 Declarative region
+      --  j) A simultaneous procedural statement
+      Open_Declarative_Region;
+
+      Sem_Sequential_Statements (Stmt, Stmt);
+
+      Close_Declarative_Region;
+
+      Set_Is_Within_Flag (Stmt, False);
+   end Sem_Simultaneous_Procedural_Statement;
+
    procedure Sem_Simultaneous_Statements (First : Iir)
    is
       Stmt : Iir;
@@ -2163,6 +2186,8 @@ package body Vhdl.Sem_Stmts is
                Sem_Simple_Simultaneous_Statement (Stmt);
             when Iir_Kind_Simultaneous_If_Statement =>
                Sem_Simultaneous_If_Statement (Stmt);
+            when Iir_Kind_Simultaneous_Procedural_Statement =>
+               Sem_Simultaneous_Procedural_Statement (Stmt);
             when others =>
                Error_Kind ("sem_simultaneous_statements", Stmt);
          end case;
@@ -2244,6 +2269,8 @@ package body Vhdl.Sem_Stmts is
             Sem_Simple_Simultaneous_Statement (Stmt);
          when Iir_Kind_Simultaneous_If_Statement =>
             Sem_Simultaneous_If_Statement (Stmt);
+         when Iir_Kind_Simultaneous_Procedural_Statement =>
+            Sem_Simultaneous_Procedural_Statement (Stmt);
          when others =>
             Error_Kind ("sem_concurrent_statement", Stmt);
       end case;