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

1 files changed, 103 insertions, 77 deletions

diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb
index 555c6a733..4ce298b40 100644
--- a/src/vhdl/vhdl-sem.adb
+++ b/src/vhdl/vhdl-sem.adb
@@ -516,17 +516,99 @@ package body Vhdl.Sem is
       return Res;
    end Sem_Insert_Anonymous_Signal;
 
+   procedure Sem_Signal_Port_Association
+     (Assoc : Iir; Formal : Iir; Formal_Base : Iir)
+   is
+      Actual : Iir;
+      Prefix : Iir;
+      Object : Iir;
+   begin
+      if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
+         Actual := Get_Actual (Assoc);
+         --  There has been an error, exit from the loop.
+         if Actual = Null_Iir then
+            return;
+         end if;
+         Object := Name_To_Object (Actual);
+         if Is_Valid (Object) and then Is_Signal_Object (Object) then
+            --  Port or signal.
+            Set_Collapse_Signal_Flag
+              (Assoc, Can_Collapse_Signals (Assoc, Formal));
+            if Get_Name_Staticness (Object) < Globally then
+               Error_Msg_Sem (+Actual, "actual must be a static name");
+            end if;
+            Check_Port_Association_Bounds_Restrictions
+              (Formal, Actual, Assoc);
+            Prefix := Get_Object_Prefix (Object);
+            case Get_Kind (Prefix) is
+               when Iir_Kind_Interface_Signal_Declaration =>
+                  declare
+                     P : Boolean;
+                     pragma Unreferenced (P);
+                  begin
+                     P := Check_Port_Association_Mode_Restrictions
+                       (Formal_Base, Prefix, Assoc);
+                  end;
+               when Iir_Kind_Signal_Declaration =>
+                  Set_Use_Flag (Prefix, True);
+               when others =>
+                  --  FIXME: attributes ?
+                  null;
+            end case;
+         else
+            --  Expression.
+            Set_Collapse_Signal_Flag (Assoc, False);
+
+            pragma Assert (Is_Null (Get_Actual_Conversion (Assoc)));
+            if Flags.Vhdl_Std >= Vhdl_93c then
+               --  LRM93 1.1.1.2 Ports
+               --  Moreover, the ports of a block may be associated
+               --  with an expression, in order to provide these ports
+               --  with constant driving values; such ports must be
+               --  of mode in.
+               if Get_Mode (Formal_Base) /= Iir_In_Mode then
+                  Error_Msg_Sem
+                    (+Assoc, "only 'in' ports may be associated with "
+                       & "expression");
+               end if;
+
+               --  Is it possible to have a globally static name that is
+               --  not readable ?
+               Check_Read (Actual);
+
+               --  LRM93 1.1.1.2 Ports
+               --  The actual, if an expression, must be a globally
+               --  static expression.
+               if Get_Expr_Staticness (Actual) < Globally then
+                  if Flags.Vhdl_Std >= Vhdl_08 then
+                     --  LRM08 6.5.6.3 Port clauses
+                     Actual := Sem_Insert_Anonymous_Signal (Formal, Actual);
+                     Set_Actual (Assoc, Actual);
+                     Set_Collapse_Signal_Flag (Assoc, True);
+                  else
+                     Error_Msg_Sem
+                       (+Actual,
+                        "actual expression must be globally static");
+                  end if;
+               end if;
+            else
+               Error_Msg_Sem
+                 (+Assoc,
+                  "cannot associate ports with expression in vhdl87");
+            end if;
+         end if;
+      end if;
+   end Sem_Signal_Port_Association;
+
    --  INTER_PARENT contains ports interfaces;
    --  ASSOC_PARENT constains ports map aspects.
    procedure Sem_Port_Association_Chain
      (Inter_Parent : Iir; Assoc_Parent : Iir)
    is
       Assoc : Iir;
-      Actual : Iir;
-      Prefix : Iir;
-      Object : Iir;
       Match : Compatibility_Level;
       Assoc_Chain : Iir;
+      Inter_Chain : Iir;
       Miss : Missing_Type;
       Inter : Iir;
       Formal : Iir;
@@ -558,10 +640,19 @@ package body Vhdl.Sem is
 
       --  The ports
       Assoc_Chain := Get_Port_Map_Aspect_Chain (Assoc_Parent);
+      Inter_Chain := Get_Port_Chain (Inter_Parent);
+
+      if AMS_Vhdl then
+         --  Mutate terminal associations, so that their formals are not
+         --  analyzed as an expression.
+         Assoc_Chain :=
+           Extract_Non_Object_Association (Assoc_Chain, Inter_Chain);
+      end if;
+
       if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
          return;
       end if;
-      Sem_Association_Chain (Get_Port_Chain (Inter_Parent), Assoc_Chain,
+      Sem_Association_Chain (Inter_Chain, Assoc_Chain,
                              True, Miss, Assoc_Parent, Match);
       Set_Port_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
       if Match = Not_Compatible then
@@ -584,79 +675,13 @@ package body Vhdl.Sem is
          Formal := Get_Association_Formal (Assoc, Inter);
          Formal_Base := Get_Interface_Of_Formal (Formal);
 
-         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
-            Actual := Get_Actual (Assoc);
-            --  There has been an error, exit from the loop.
-            exit when Actual = Null_Iir;
-            Object := Name_To_Object (Actual);
-            if Is_Valid (Object) and then Is_Signal_Object (Object) then
-               --  Port or signal.
-               Set_Collapse_Signal_Flag
-                 (Assoc, Can_Collapse_Signals (Assoc, Formal));
-               if Get_Name_Staticness (Object) < Globally then
-                  Error_Msg_Sem (+Actual, "actual must be a static name");
-               end if;
-               Check_Port_Association_Bounds_Restrictions
-                 (Formal, Actual, Assoc);
-               Prefix := Get_Object_Prefix (Object);
-               case Get_Kind (Prefix) is
-                  when Iir_Kind_Interface_Signal_Declaration =>
-                     declare
-                        P : Boolean;
-                        pragma Unreferenced (P);
-                     begin
-                        P := Check_Port_Association_Mode_Restrictions
-                          (Formal_Base, Prefix, Assoc);
-                     end;
-                  when Iir_Kind_Signal_Declaration =>
-                     Set_Use_Flag (Prefix, True);
-                  when others =>
-                     --  FIXME: attributes ?
-                     null;
-               end case;
-            else
-               --  Expression.
-               Set_Collapse_Signal_Flag (Assoc, False);
-
-               pragma Assert (Is_Null (Get_Actual_Conversion (Assoc)));
-               if Flags.Vhdl_Std >= Vhdl_93c then
-                  --  LRM93 1.1.1.2 Ports
-                  --  Moreover, the ports of a block may be associated
-                  --  with an expression, in order to provide these ports
-                  --  with constant driving values; such ports must be
-                  --  of mode in.
-                  if Get_Mode (Formal_Base) /= Iir_In_Mode then
-                     Error_Msg_Sem
-                       (+Assoc, "only 'in' ports may be associated with "
-                          & "expression");
-                  end if;
+         case Get_Kind (Formal_Base) is
+            when Iir_Kind_Interface_Signal_Declaration =>
+               Sem_Signal_Port_Association (Assoc, Formal, Formal_Base);
+            when others =>
+               null;
+         end case;
 
-                  --  Is it possible to have a globally static name that is
-                  --  not readable ?
-                  Check_Read (Actual);
-
-                  --  LRM93 1.1.1.2 Ports
-                  --  The actual, if an expression, must be a globally
-                  --  static expression.
-                  if Get_Expr_Staticness (Actual) < Globally then
-                     if Flags.Vhdl_Std >= Vhdl_08 then
-                        --  LRM08 6.5.6.3 Port clauses
-                        Actual := Sem_Insert_Anonymous_Signal (Formal, Actual);
-                        Set_Actual (Assoc, Actual);
-                        Set_Collapse_Signal_Flag (Assoc, True);
-                     else
-                        Error_Msg_Sem
-                          (+Actual,
-                           "actual expression must be globally static");
-                     end if;
-                  end if;
-               else
-                  Error_Msg_Sem
-                    (+Assoc,
-                     "cannot associate ports with expression in vhdl87");
-               end if;
-            end if;
-         end if;
          Next_Association_Interface (Assoc, Inter);
       end loop;
    end Sem_Port_Association_Chain;
@@ -2697,7 +2722,8 @@ package body Vhdl.Sem is
       Inter := Get_Generic_Chain (Header);
       while Is_Valid (Inter) loop
          case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
-            when Iir_Kinds_Interface_Object_Declaration =>
+            when Iir_Kinds_Interface_Object_Declaration
+              | Iir_Kind_Interface_Terminal_Declaration =>
                null;
             when Iir_Kind_Interface_Type_Declaration =>
                return True;