synth-vhdl_expr: improve support of external names.

1 files changed, 120 insertions, 62 deletions

diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index c73b2133e..65e0a9d27 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -831,71 +831,136 @@ package body Synth.Vhdl_Expr is
       end case;
    end Synth_Subtype_Conversion;
 
+   function Synth_Pathname_Object (Loc_Inst : Synth_Instance_Acc;
+                                   Name : Node;
+                                   Cur_Inst : Synth_Instance_Acc;
+                                   Path : Node) return Valtyp
+   is
+      Id : constant Name_Id := Get_Identifier (Path);
+      Scope : constant Node := Get_Source_Scope (Cur_Inst);
+      Obj : Node;
+      Res : Valtyp;
+   begin
+      --  Object simple name.
+      case Get_Kind (Scope) is
+         when Iir_Kind_Architecture_Body =>
+            Obj := Find_Name_In_Chain (Get_Declaration_Chain (Scope), Id);
+         when others =>
+            Error_Kind ("synth_pathname_object(1)", Scope);
+      end case;
+
+      --  LRM08 8.7 External names
+      --  It is an error when evaluating an external name if the identified
+      --  declarative region does not contain a declaration of an object
+      --  whose simple name is the object simple name of the external
+      --  pathname.
+      if Obj = Null_Node then
+         Error_Msg_Synth
+           (Loc_Inst, Path, "cannot find object %i in %i", (+Id, +Scope));
+         return No_Valtyp;
+      end if;
+
+      --  LRM08 8.7 External names
+      --  It is also an error when evaluating an external name if the object
+      --  denoted by an external constant name is not a constant, or if the
+      --  object denoted by an external signal name is not a signal, or if
+      --  the object denoted by an external variable name is not a variable.
+      case Get_Kind (Obj) is
+         when Iir_Kind_Signal_Declaration =>
+            case Iir_Kinds_External_Name (Get_Kind (Name)) is
+               when Iir_Kind_External_Signal_Name =>
+                  Res := Get_Value (Cur_Inst, Obj);
+               when Iir_Kind_External_Constant_Name
+                 | Iir_Kind_External_Variable_Name =>
+                  Error_Msg_Synth
+                    (Loc_Inst, Path, "object name %i is a signal", +Obj);
+                  return No_Valtyp;
+            end case;
+         when others =>
+            Error_Kind ("synth_pathname_object(2)", Obj);
+      end case;
+
+      --  LRM08 8.7 External names
+      --  Moreover, it is an error if the base type of the object denoted by
+      --  an external name is not the same as the base type mark in the
+      --  subtype indication of the external name.
+      declare
+         Obj_Type : constant Node := Get_Type (Obj);
+         Name_Type : constant Node := Get_Type (Name);
+      begin
+         if Get_Base_Type (Obj_Type) /= Get_Base_Type (Name_Type) then
+            Error_Msg_Synth
+              (Loc_Inst, Path, "external name and object have different type");
+            return No_Valtyp;
+         end if;
+      end;
+
+      --  LRM08 8.7 External names
+      --  If the subtype indication denotes a composite subtype, then the
+      --  object denoted by the external name is viewed as if it were of the
+      --  subtype specified by the subtype indication.  For each index range,
+      --  if any, in the subtype, if the subtype defines the index range, the
+      --  object is viewed with that index range; otherwise, the object
+      --  is viewed with the index range of the object.  The view specified
+      --  by the subtype shall include a matching element (see 9.2.3) for
+      --  each element of the object denoted by the external name.
+      --
+      --  If the subtype indication denotes a scalar subtype, then the object
+      --  denoted by the external name is viewed as if it were of the subtype
+      --  specified by the subtype indication; moreover, it is a error when
+      --  evaluating the external name if this subtype does not have the same
+      --  bounds and direction as the subtype of the object denoted by the
+      --  external name.
+
+      --  TODO.
+
+      return Res;
+   end Synth_Pathname_Object;
+
    function Synth_Pathname (Loc_Inst : Synth_Instance_Acc;
                             Name : Node;
                             Cur_Inst : Synth_Instance_Acc;
                             Path : Node) return Valtyp
    is
       Suffix : constant Node := Get_Pathname_Suffix (Path);
-      Id : constant Name_Id := Get_Identifier (Path);
-      Scope : constant Node := Get_Source_Scope (Cur_Inst);
+      Id : Name_Id;
+      Scope : Node;
       Res : Node;
    begin
       if Suffix = Null_Node then
          --  Object simple name.
-         case Get_Kind (Scope) is
-            when Iir_Kind_Architecture_Body =>
-               Res := Find_Name_In_Chain (Get_Declaration_Chain (Scope), Id);
-            when others =>
-               Error_Kind ("synth_pathname(obj)", Scope);
-         end case;
-         if Res = Null_Node then
-            Error_Msg_Synth
-              (Loc_Inst, Path, "cannot find object %i in %i", (+Id, +Scope));
-            return No_Valtyp;
-         end if;
-         case Get_Kind (Res) is
-            when Iir_Kind_Signal_Declaration =>
-               case Iir_Kinds_External_Name (Get_Kind (Name)) is
-                  when Iir_Kind_External_Signal_Name =>
-                     return Get_Value (Cur_Inst, Res);
-                  when Iir_Kind_External_Constant_Name
-                    | Iir_Kind_External_Variable_Name =>
-                     Error_Msg_Synth
-                       (Loc_Inst, Path, "object name %i is a signal", +Res);
-                     return No_Valtyp;
-               end case;
-            when others =>
-               Error_Kind ("synth_pathname(1)", Res);
-         end case;
-      else
-         --  Find name in concurrent statements.
-         case Get_Kind (Scope) is
-            when Iir_Kind_Architecture_Body =>
-               Res := Find_Name_In_Chain
-                 (Get_Concurrent_Statement_Chain (Scope), Id);
-            when others =>
-               Error_Kind ("synth_pathname(scope)", Scope);
-         end case;
-         if Res = Null_Node then
-            Error_Msg_Synth
-              (Loc_Inst, Path,
-               "cannot find path element %i in %i", (+Id, +Scope));
-            return No_Valtyp;
-         end if;
-         case Get_Kind (Res) is
-            when Iir_Kind_Component_Instantiation_Statement =>
-               if Is_Entity_Instantiation (Res) then
-                  return Synth_Pathname
-                    (Loc_Inst, Name, Get_Sub_Instance (Cur_Inst, Res), Suffix);
-               else
-                  --  TODO: skip component.
-                  raise Internal_Error;
-               end if;
-            when others =>
-               Error_Kind ("synth_pathname(2)", Res);
-         end case;
+         return Synth_Pathname_Object (Loc_Inst, Name, Cur_Inst, Path);
+      end if;
+
+      Id := Get_Identifier (Path);
+      Scope := Get_Source_Scope (Cur_Inst);
+
+      --  Find name in concurrent statements.
+      case Get_Kind (Scope) is
+         when Iir_Kind_Architecture_Body =>
+            Res := Find_Name_In_Chain
+              (Get_Concurrent_Statement_Chain (Scope), Id);
+         when others =>
+            Error_Kind ("synth_pathname(scope)", Scope);
+      end case;
+      if Res = Null_Node then
+         Error_Msg_Synth
+           (Loc_Inst, Path,
+            "cannot find path element %i in %i", (+Id, +Scope));
+         return No_Valtyp;
       end if;
+      case Get_Kind (Res) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            if Is_Entity_Instantiation (Res) then
+               return Synth_Pathname
+                 (Loc_Inst, Name, Get_Sub_Instance (Cur_Inst, Res), Suffix);
+            else
+               --  TODO: skip component.
+               raise Internal_Error;
+            end if;
+         when others =>
+            Error_Kind ("synth_pathname(2)", Res);
+      end case;
    end Synth_Pathname;
 
    function Synth_Absolute_Pathname
@@ -922,21 +987,14 @@ package body Synth.Vhdl_Expr is
                                 return Valtyp
    is
       Path : Node;
-      Res : Valtyp;
    begin
       Path := Get_External_Pathname (Name);
       case Get_Kind (Path) is
          when Iir_Kind_Absolute_Pathname =>
-            Res := Synth_Absolute_Pathname (Syn_Inst, Name, Path);
+            return Synth_Absolute_Pathname (Syn_Inst, Name, Path);
          when others =>
             Error_Kind ("synth_external_name", Path);
       end case;
-      if Res = No_Valtyp then
-         return No_Valtyp;
-      end if;
-
-      --  TODO: type.
-      return Res;
    end Synth_External_Name;
 
    function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)