vhdl: improve support of AMS-vhdl (array and record natures, source quantities)

1 files changed, 238 insertions, 43 deletions

diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index 35d49fc33..4a420b3a1 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -41,6 +41,8 @@ package body Vhdl.Sem_Stmts is
    --  get_associated_chain (for case statement).
    procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir);
 
+   procedure Sem_Simultaneous_Statements (First : Iir);
+
    -- Access to the current subprogram or process.
    Current_Subprogram: Iir := Null_Iir;
 
@@ -694,10 +696,23 @@ package body Vhdl.Sem_Stmts is
       Set_Guard (Stmt, Guard);
    end Sem_Guard;
 
+   --  Analyze optional Condition field of PARENT.
+   procedure Sem_Condition_Opt (Parent : Iir)
+   is
+      Cond : Iir;
+   begin
+      Cond := Get_Condition (Parent);
+      if Cond /= Null_Iir then
+         Cond := Sem_Condition (Cond);
+         if Cond /= Null_Iir then
+            Set_Condition (Parent, Cond);
+         end if;
+      end if;
+   end Sem_Condition_Opt;
+
    procedure Sem_Signal_Assignment (Stmt: Iir)
    is
       Cond_Wf : Iir_Conditional_Waveform;
-      Expr : Iir;
       Wf_Chain : Iir_Waveform_Element;
       Target_Type : Iir;
       Done : Boolean;
@@ -731,13 +746,7 @@ package body Vhdl.Sem_Stmts is
                   end if;
                   if S = Resolve_Stage_1 then
                      --  Must be analyzed only once.
-                     Expr := Get_Condition (Cond_Wf);
-                     if Expr /= Null_Iir then
-                        Expr := Sem_Condition (Expr);
-                        if Expr /= Null_Iir then
-                           Set_Condition (Cond_Wf, Expr);
-                        end if;
-                     end if;
+                     Sem_Condition_Opt (Cond_Wf);
                   end if;
                   Cond_Wf := Get_Chain (Cond_Wf);
                end loop;
@@ -1174,7 +1183,8 @@ package body Vhdl.Sem_Stmts is
             case Get_Kind (Prefix) is
                when Iir_Kind_Signal_Declaration
                  | Iir_Kind_Guard_Signal_Declaration
-                 | Iir_Kinds_Signal_Attribute =>
+                 | Iir_Kinds_Signal_Attribute
+                 | Iir_Kind_Above_Attribute =>
                   null;
                when Iir_Kind_Interface_Signal_Declaration =>
                   if not Is_Interface_Signal_Readable (Prefix) then
@@ -1234,6 +1244,71 @@ package body Vhdl.Sem_Stmts is
       end loop;
    end Mark_Suspendable;
 
+   function Sem_Real_Or_Time_Timeout (Expr : Iir) return Iir
+   is
+      Res : Iir;
+      Res_Type : Iir;
+   begin
+      Res := Sem_Expression_Ov (Expr, Null_Iir);
+
+      if Res = Null_Iir then
+         --  Error occurred.
+         return Res;
+      end if;
+
+      Res_Type := Get_Type (Res);
+      if not Is_Overload_List (Res_Type) then
+         Res_Type := Get_Base_Type (Get_Type (Res));
+         if Res_Type = Time_Type_Definition
+           or else Res_Type = Real_Type_Definition
+         then
+            Check_Read (Res);
+            return Res;
+         else
+            Error_Msg_Sem
+              (+Expr, "timeout expression must be of type time or real");
+            return Expr;
+         end if;
+      else
+         --  Many interpretations.
+         declare
+            Res_List : constant Iir_List := Get_Overload_List (Res_Type);
+            It : List_Iterator;
+            El : Iir;
+            Nbr_Res : Natural;
+         begin
+            Nbr_Res := 0;
+
+            --  Extract boolean interpretations.
+            It := List_Iterate (Res_List);
+            while Is_Valid (It) loop
+               El := Get_Base_Type (Get_Element (It));
+               if Are_Basetypes_Compatible (El, Time_Type_Definition)
+                 /= Not_Compatible
+               then
+                  Res_Type := Time_Type_Definition;
+                  Nbr_Res := Nbr_Res + 1;
+               elsif Are_Basetypes_Compatible (El, Real_Type_Definition)
+                 /= Not_Compatible
+               then
+                  Res_Type := Real_Type_Definition;
+                  Nbr_Res := Nbr_Res + 1;
+               end if;
+               Next (It);
+            end loop;
+
+            if Nbr_Res = 1 then
+               Res := Sem_Expression_Ov (Expr, Res_Type);
+               Check_Read (Res);
+               return Res;
+            else
+               Error_Overload (Expr);
+               return Expr;
+            end if;
+         end;
+      end if;
+   end Sem_Real_Or_Time_Timeout;
+
    procedure Sem_Wait_Statement (Stmt: Iir_Wait_Statement)
    is
       Expr: Iir;
@@ -1285,15 +1360,20 @@ package body Vhdl.Sem_Stmts is
 
       Expr := Get_Timeout_Clause (Stmt);
       if Expr /= Null_Iir then
-         Expr := Sem_Expression (Expr, Time_Type_Definition);
-         if Expr /= Null_Iir then
-            Check_Read (Expr);
-            Expr := Eval_Expr_If_Static (Expr);
+         if AMS_Vhdl then
+            Expr := Sem_Real_Or_Time_Timeout (Expr);
             Set_Timeout_Clause (Stmt, Expr);
-            if Get_Expr_Staticness (Expr) = Locally
-              and then Get_Physical_Value (Expr) < 0
-            then
-               Error_Msg_Sem (+Stmt, "timeout value must be positive");
+         else
+            Expr := Sem_Expression (Expr, Time_Type_Definition);
+            if Expr /= Null_Iir then
+               Check_Read (Expr);
+               Expr := Eval_Expr_If_Static (Expr);
+               Set_Timeout_Clause (Stmt, Expr);
+               if Get_Expr_Staticness (Expr) = Locally
+                 and then Get_Physical_Value (Expr) < 0
+               then
+                  Error_Msg_Sem (+Stmt, "timeout value must be positive");
+               end if;
             end if;
          end if;
       end if;
@@ -1303,17 +1383,12 @@ package body Vhdl.Sem_Stmts is
 
    procedure Sem_Exit_Next_Statement (Stmt : Iir)
    is
-      Cond: Iir;
       Loop_Label : Iir;
       Loop_Stmt: Iir;
       P : Iir;
    begin
       --  Analyze condition (if present).
-      Cond := Get_Condition (Stmt);
-      if Cond /= Null_Iir then
-         Cond := Sem_Condition (Cond);
-         Set_Condition (Stmt, Cond);
-      end if;
+      Sem_Condition_Opt (Stmt);
 
       --  Analyze label.
       Loop_Label := Get_Loop_Label (Stmt);
@@ -1361,6 +1436,84 @@ package body Vhdl.Sem_Stmts is
       end loop;
    end Sem_Exit_Next_Statement;
 
+   function Sem_Quantity_Name (Name : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Sem_Name (Name);
+
+      Res := Get_Named_Entity (Name);
+
+      if Res = Error_Mark then
+         return Null_Iir;
+      elsif Is_Overload_List (Res) then
+         Error_Msg_Sem (+Name, "quantity name expected");
+         return Null_Iir;
+      else
+         Res := Finish_Sem_Name (Name);
+         if not Is_Quantity_Name (Res) then
+            Error_Msg_Sem (+Name, "%n is not a quantity name", +Res);
+            return Null_Iir;
+         else
+            return Res;
+         end if;
+      end if;
+   end Sem_Quantity_Name;
+
+   procedure Sem_Break_List (First : Iir)
+   is
+      El : Iir;
+      Name : Iir;
+      Break_Quantity : Iir;
+      Sel_Quantity : Iir;
+      Expr : Iir;
+      Expr_Type : Iir;
+   begin
+      El := First;
+      while El /= Null_Iir loop
+         Name := Get_Break_Quantity (El);
+         Break_Quantity := Sem_Quantity_Name (Name);
+
+         --  AMS-LRM17 10.15 Break statement
+         --  The break quantity, the selector quantity, and the expression
+         --  shall have the same type [...]
+         if Break_Quantity /= Null_Iir then
+            Set_Break_Quantity (El, Break_Quantity);
+            Expr_Type := Get_Type (Break_Quantity);
+         else
+            Expr_Type := Null_Iir;
+         end if;
+
+         Expr := Get_Expression (El);
+         Expr := Sem_Expression (Expr, Expr_Type);
+         if Expr /= Null_Iir then
+            Set_Expression (El, Expr);
+         end if;
+
+         Sel_Quantity := Get_Selector_Quantity (El);
+         if Sel_Quantity /= Null_Iir then
+            Sel_Quantity := Sem_Quantity_Name (Name);
+            if Sel_Quantity /= Null_Iir and then Expr_Type /= Null_Iir then
+               if Is_Expr_Compatible (Expr_Type, Sel_Quantity) = Not_Compatible
+               then
+                  Error_Msg_Sem (+Sel_Quantity,
+                                 "selector quantity must be of the same type "
+                                   & "as the break quantity");
+               end if;
+            end if;
+         end if;
+
+         El := Get_Chain (El);
+      end loop;
+   end Sem_Break_List;
+
+   procedure Sem_Break_Statement (Stmt : Iir) is
+   begin
+      Sem_Break_List (Get_Break_Element (Stmt));
+
+      Sem_Condition_Opt (Stmt);
+   end Sem_Break_Statement;
+
    -- Process is the scope, this is also the process for which drivers can
    -- be created.
    procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir)
@@ -1375,14 +1528,9 @@ package body Vhdl.Sem_Stmts is
             when Iir_Kind_If_Statement =>
                declare
                   Clause: Iir := Stmt;
-                  Cond: Iir;
                begin
                   while Clause /= Null_Iir loop
-                     Cond := Get_Condition (Clause);
-                     if Cond /= Null_Iir then
-                        Cond := Sem_Condition (Cond);
-                        Set_Condition (Clause, Cond);
-                     end if;
+                     Sem_Condition_Opt (Clause);
                      Sem_Sequential_Statements_Internal
                        (Get_Sequential_Statement_Chain (Clause));
                      Clause := Get_Else_Clause (Clause);
@@ -1408,17 +1556,9 @@ package body Vhdl.Sem_Stmts is
                   Close_Declarative_Region;
                end;
             when Iir_Kind_While_Loop_Statement =>
-               declare
-                  Cond: Iir;
-               begin
-                  Cond := Get_Condition (Stmt);
-                  if Cond /= Null_Iir then
-                     Cond := Sem_Condition (Cond);
-                     Set_Condition (Stmt, Cond);
-                  end if;
-                  Sem_Sequential_Statements_Internal
-                    (Get_Sequential_Statement_Chain (Stmt));
-               end;
+               Sem_Condition_Opt (Stmt);
+               Sem_Sequential_Statements_Internal
+                 (Get_Sequential_Statement_Chain (Stmt));
             when Iir_Kind_Simple_Signal_Assignment_Statement
               | Iir_Kind_Conditional_Signal_Assignment_Statement =>
                Sem_Signal_Assignment (Stmt);
@@ -1443,6 +1583,8 @@ package body Vhdl.Sem_Stmts is
                Sem_Case_Statement (Stmt);
             when Iir_Kind_Wait_Statement =>
                Sem_Wait_Statement (Stmt);
+            when Iir_Kind_Break_Statement =>
+               Sem_Break_Statement (Stmt);
             when Iir_Kind_Procedure_Call_Statement =>
                declare
                   Call : constant Iir := Get_Procedure_Call (Stmt);
@@ -1940,7 +2082,22 @@ package body Vhdl.Sem_Stmts is
       Sem_Guard (Stmt);
    end Sem_Concurrent_Selected_Signal_Assignment;
 
-   procedure Simple_Simultaneous_Statement (Stmt : Iir) is
+   procedure Sem_Concurrent_Break_Statement (Stmt : Iir)
+   is
+      Sensitivity_List : Iir_List;
+   begin
+      Sem_Break_List (Get_Break_Element (Stmt));
+
+      Sensitivity_List := Get_Sensitivity_List (Stmt);
+      if Sensitivity_List /= Null_Iir_List then
+         Sem_Sensitivity_List (Sensitivity_List);
+      end if;
+
+      Sem_Condition_Opt (Stmt);
+   end Sem_Concurrent_Break_Statement;
+
+   procedure Sem_Simple_Simultaneous_Statement (Stmt : Iir)
+   is
       Left, Right : Iir;
       Res_Type : Iir;
    begin
@@ -1955,6 +2112,9 @@ package body Vhdl.Sem_Stmts is
          return;
       end if;
 
+      Set_Simultaneous_Left (Stmt, Left);
+      Set_Simultaneous_Right (Stmt, Right);
+
       Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right));
       if Res_Type = Null_Iir then
          Error_Msg_Sem
@@ -1963,7 +2123,38 @@ package body Vhdl.Sem_Stmts is
       end if;
 
       --  FIXME: check for nature type...
-   end Simple_Simultaneous_Statement;
+   end Sem_Simple_Simultaneous_Statement;
+
+   procedure Sem_Simultaneous_If_Statement (Stmt : Iir)
+   is
+      Clause : Iir;
+   begin
+      Clause := Stmt;
+      while Clause /= Null_Iir loop
+         Sem_Condition_Opt (Clause);
+         Sem_Simultaneous_Statements
+           (Get_Simultaneous_Statement_Chain (Clause));
+         Clause := Get_Else_Clause (Clause);
+      end loop;
+   end Sem_Simultaneous_If_Statement;
+
+   procedure Sem_Simultaneous_Statements (First : Iir)
+   is
+      Stmt : Iir;
+   begin
+      Stmt := First;
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Simple_Simultaneous_Statement =>
+               Sem_Simple_Simultaneous_Statement (Stmt);
+            when Iir_Kind_Simultaneous_If_Statement =>
+               Sem_Simultaneous_If_Statement (Stmt);
+            when others =>
+               Error_Kind ("sem_simultaneous_statements", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Sem_Simultaneous_Statements;
 
    procedure Sem_Concurrent_Statement (Stmt : in out Iir; Is_Passive : Boolean)
    is
@@ -2019,6 +2210,8 @@ package body Vhdl.Sem_Stmts is
          when Iir_Kind_Concurrent_Procedure_Call_Statement =>
             Stmt :=
               Sem_Concurrent_Procedure_Call_Statement (Stmt, Is_Passive);
+         when Iir_Kind_Concurrent_Break_Statement =>
+            Sem_Concurrent_Break_Statement (Stmt);
          when Iir_Kind_Psl_Declaration =>
             Sem_Psl.Sem_Psl_Declaration (Stmt);
          when Iir_Kind_Psl_Endpoint_Declaration =>
@@ -2034,7 +2227,9 @@ package body Vhdl.Sem_Stmts is
          when Iir_Kind_Psl_Default_Clock =>
             Sem_Psl.Sem_Psl_Default_Clock (Stmt);
          when Iir_Kind_Simple_Simultaneous_Statement =>
-            Simple_Simultaneous_Statement (Stmt);
+            Sem_Simple_Simultaneous_Statement (Stmt);
+         when Iir_Kind_Simultaneous_If_Statement =>
+            Sem_Simultaneous_If_Statement (Stmt);
          when others =>
             Error_Kind ("sem_concurrent_statement", Stmt);
       end case;