Put attribute_value_chain in parent.

12 files changed, 201 insertions, 175 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index cd2dae0fd..883e89e1b 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -1273,8 +1273,6 @@ package body Canon is
       --  word POSTPONED.
       Set_Postponed_Flag (Proc, Get_Postponed_Flag (El));
 
-      Set_Attribute_Value_Chain (Proc, Get_Attribute_Value_Chain (El));
-
       Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement);
       Set_Sequential_Statement_Chain (Proc, Call_Stmt);
       Location_Copy (Call_Stmt, El);
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index d6429e251..d7166da5d 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -23,6 +23,7 @@ with Tokens; use Tokens;
 with Name_Table;
 with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164;
 with Sem_Scopes;
+with Sem_Specs;
 with Evaluation;
 with Sem;
 with Iirs_Utils;
@@ -1313,18 +1314,14 @@ package body Ieee.Vital_Timing is
       Value : Iir_Attribute_Value;
       Spec : Iir_Attribute_Specification;
    begin
-      Value := Get_Attribute_Value_Chain (Unit);
-      while Value /= Null_Iir loop
-         Spec := Get_Attribute_Specification (Value);
-         if Get_Named_Entity (Get_Attribute_Designator (Spec))
-           = Vital_Level0_Attribute
-         then
-            return True;
-         end if;
-         Value := Get_Chain (Value);
-      end loop;
-
-      return False;
+      Value := Sem_Specs.Find_Attribute_Value
+        (Unit, Std_Names.Name_VITAL_Level0);
+      if Value = Null_Iir then
+         return False;
+      end if;
+      Spec := Get_Attribute_Specification (Value);
+      return Get_Named_Entity (Get_Attribute_Designator (Spec))
+        = Vital_Level0_Attribute;
    end Is_Vital_Level0;
 
    procedure Check_Vital_Level0_Architecture (Arch : Iir_Architecture_Body)
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 7d2eb6748..04649b572 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -1449,14 +1449,14 @@ package body Iirs is
    begin
       pragma Assert (Package_Body /= Null_Iir);
       pragma Assert (Has_Package (Get_Kind (Package_Body)));
-      return Get_Field4 (Package_Body);
+      return Get_Field5 (Package_Body);
    end Get_Package;
 
    procedure Set_Package (Package_Body : Iir; Decl : Iir) is
    begin
       pragma Assert (Package_Body /= Null_Iir);
       pragma Assert (Has_Package (Get_Kind (Package_Body)));
-      Set_Field4 (Package_Body, Decl);
+      Set_Field5 (Package_Body, Decl);
    end Set_Package;
 
    function Get_Package_Body (Pkg : Iir) return Iir is
@@ -1701,14 +1701,14 @@ package body Iirs is
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Subprogram_Specification (Get_Kind (Target)));
-      return Get_Field4 (Target);
+      return Get_Field6 (Target);
    end Get_Subprogram_Specification;
 
    procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Subprogram_Specification (Get_Kind (Target)));
-      Set_Field4 (Target, Spec);
+      Set_Field6 (Target, Spec);
    end Set_Subprogram_Specification;
 
    function Get_Sequential_Statement_Chain (Target : Iir) return Iir is
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 28c11481c..90d3157d2 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -827,8 +827,10 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
    --  The corresponding package declaration.
-   --   Get/Set_Package (Field4)
+   --   Get/Set_Package (Field5)
    --
    --   Get/Set_End_Has_Reserved_Id (Flag8)
    --
@@ -884,8 +886,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Generic_Chain (Field6)
    --
    --   Get/Set_Port_Chain (Field7)
@@ -1014,8 +1014,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Visible_Flag (Flag4)
    --
    --   Get/Set_Use_Flag (Flag6)
@@ -1035,8 +1033,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Subtype_Indication (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -1055,8 +1051,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Visible_Flag (Flag4)
    --
    --   Get/Set_Use_Flag (Flag6)
@@ -1071,8 +1065,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Visible_Flag (Flag4)
    --
    --   Get/Set_Use_Flag (Flag6)
@@ -1096,8 +1088,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Subtype_Indication (Field5)
    --
    --  Must always be null_iir for iir_kind_interface_file_declaration.
@@ -1203,8 +1193,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Interface_Declaration_Chain (Field5)
    --
    --   Get/Set_Generic_Chain (Field6)
@@ -1278,10 +1266,12 @@ package Iirs is
    --
    --   Get/Set_Impure_Depth (Field3)
    --
-   --   Get/Set_Subprogram_Specification (Field4)
+   --   Get/Set_Attribute_Value_Chain (Field4)
    --
    --   Get/Set_Sequential_Statement_Chain (Field5)
    --
+   --   Get/Set_Subprogram_Specification (Field6)
+   --
    --   Get/Set_Callees_List (Field7)
    --
    --   Get/Set_End_Has_Reserved_Id (Flag8)
@@ -1307,8 +1297,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Interface_Declaration_Chain (Field5)
    --
    --   Get/Set_Generic_Chain (Field6)
@@ -1346,8 +1334,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Subtype_Indication (Field5)
    --
    --   Get/Set_Default_Value (Field6)
@@ -1388,8 +1374,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Guard_Sensitivity_List (Field6)
    --
    --   Get/Set_Block_Statement (Field7)
@@ -1417,8 +1401,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --  For iterator, this is the reconstructed subtype indication.
    --   Get/Set_Subtype_Indication (Field5)
    --
@@ -1468,8 +1450,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Subtype_Indication (Field5)
    --
    --   Get/Set_Default_Value (Field6)
@@ -1514,8 +1494,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Subtype_Indication (Field5)
    --
    --   Get/Set_File_Logical_Name (Field6)
@@ -1636,8 +1614,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Group_Template_Name (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -1688,8 +1664,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Default_Value (Field6)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -1711,8 +1685,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Default_Value (Field6)
    --
    --   Get/Set_Tolerance (Field7)
@@ -1811,6 +1783,8 @@ package Iirs is
    --  same; in other words, there may be severals literals with the same
    --  value.
    --
+   --  The parent of an enumeration_literal is the same parent as the type
+   --  declaration.
    --   Get/Set_Parent (Field0)
    --
    --   Get/Set_Type (Field1)
@@ -1820,8 +1794,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --  The declaration of the literal.  If LITERAL_ORIGIN is not set, then this
    --  is the node itself, else this is the literal defined.
    --   Get/Set_Enumeration_Decl (Field6)
@@ -1874,6 +1846,8 @@ package Iirs is
    --
    --  physical_literal ::= [ abstract_literal ] /unit/_name
    --
+   --  The parent of a physical unit is the same parent as the type
+   --  declaration.
    --   Get/Set_Parent (Field0)
    --
    --   Get/Set_Type (Field1)
@@ -1882,8 +1856,6 @@ package Iirs is
    --
    --   Get/Set_Identifier (Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --  The Physical_Literal is the expression that appear in the sources, so
    --  this is Null_Iir for a primary unit.
    --   Get/Set_Physical_Literal (Field6)
@@ -2368,8 +2340,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment:
    --   Get/Set_Expression (Field5)
    --
@@ -2452,8 +2422,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Severity_Expression (Field5)
    --
    --   Get/Set_Report_Expression (Field6)
@@ -2485,8 +2453,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Severity_Expression (Field5)
    --
    --   Get/Set_Report_Expression (Field6)
@@ -2523,8 +2489,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Default_Binding_Indication (Field5)
    --
    --   Get/Set_Generic_Map_Aspect_Chain (Field8)
@@ -2617,8 +2581,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Simultaneous_Left (Field5)
    --
    --   Get/Set_Simultaneous_Right (Field6)
@@ -2649,9 +2611,6 @@ package Iirs is
    -- Only for Iir_Kind_If_Statement:
    --   Get/Set_Identifier (Alias Field3)
    --
-   -- Only for Iir_Kind_If_Statement:
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Sequential_Statement_Chain (Field5)
    --
    --  Must be an Iir_kind_elsif node, or NULL for no more elsif clauses.
@@ -2689,8 +2648,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Sequential_Statement_Chain (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2710,8 +2667,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Sequential_Statement_Chain (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2740,8 +2695,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Loop_Label (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2757,8 +2710,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --  The waveform.
    --  If the waveform_chain is null_iir, then the signal assignment is a
    --  disconnection statement, ie TARGET <= null_iir after disconection_time,
@@ -2785,8 +2736,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Expression (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2802,8 +2751,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Severity_Expression (Field5)
    --
    --   Get/Set_Report_Expression (Field6)
@@ -2819,8 +2766,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Severity_Expression (Field5)
    --
    --   Get/Set_Report_Expression (Field6)
@@ -2838,8 +2783,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Condition_Clause (Field5)
    --
    --   Get/Set_Sensitivity_List (Field6)
@@ -2859,8 +2802,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Expression (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2877,8 +2818,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Expression (Field5)
    --
    --   Get/Set_Visible_Flag (Flag4)
@@ -2897,8 +2836,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    -- Only for Iir_Kind_Concurrent_Procedure_Call_Statement:
    --   Get/Set_Postponed_Flag (Flag3)
    --
@@ -2924,8 +2861,6 @@ package Iirs is
    --   Get/Set_Label (Field3)
    --   Get/Set_Identifier (Alias Field3)
    --
-   --   Get/Set_Attribute_Value_Chain (Field4)
-   --
    --   Get/Set_Visible_Flag (Flag4)
 
    ----------------
@@ -5302,7 +5237,7 @@ package Iirs is
    function Get_Configuration_Item_Chain (Target : Iir) return Iir;
    procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir);
 
-   --  Chain of attribute values for a named entity.
+   --  Chain of attribute values for declared items.
    --  To be used with Get/Set_Chain.
    --  There is no order, therefore, a new attribute value may be always
    --  prepended.
@@ -5328,7 +5263,7 @@ package Iirs is
    procedure Set_Entity_Name (Arch : Iir; Entity : Iir);
 
    --  The package declaration corresponding to the body.
-   --  Field: Field4 Ref
+   --  Field: Field5 Ref
    function Get_Package (Package_Body : Iir) return Iir;
    procedure Set_Package (Package_Body : Iir; Decl : Iir);
 
@@ -5414,7 +5349,7 @@ package Iirs is
    procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir);
    pragma Inline (Get_Interface_Declaration_Chain);
 
-   --  Field: Field4 Ref
+   --  Field: Field6 Ref
    function Get_Subprogram_Specification (Target : Iir) return Iir;
    procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir);
 
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index b890c46b1..be5dbdcea 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -2427,7 +2427,6 @@ package body Nodes_Meta is
       Field_Use_Flag,
       Field_Type_Definition,
       Field_Chain,
-      Field_Attribute_Value_Chain,
       Field_Parent,
       --  Iir_Kind_Anonymous_Type_Declaration
       Field_Identifier,
@@ -2441,7 +2440,6 @@ package body Nodes_Meta is
       Field_Use_Flag,
       Field_Is_Ref,
       Field_Chain,
-      Field_Attribute_Value_Chain,
       Field_Subtype_Indication,
       Field_Parent,
       Field_Type,
@@ -2451,7 +2449,6 @@ package body Nodes_Meta is
       Field_Use_Flag,
       Field_Nature,
       Field_Chain,
-      Field_Attribute_Value_Chain,
       Field_Parent,
       --  Iir_Kind_Subnature_Declaration
       Field_Identifier,
@@ -2459,7 +2456,6 @@ package body Nodes_Meta is
       Field_Use_Flag,
       Field_Nature,
       Field_Chain,
-      Field_Attribute_Value_Chain,
       Field_Parent,
       --  Iir_Kind_Package_Declaration
       Field_Identifier,
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 0f3d9f5d5..98895f4a6 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -1447,31 +1447,33 @@ package body Parse is
    --  precond : a token
    --  postcond: next token
    --
-   --  [ §3.1.1 ]
+   --  [ LRM93 3.1.1 ]
    --  enumeration_type_definition ::=
    --      ( enumeration_literal { , enumeration_literal } )
    --
-   --  [ §3.1.1 ]
+   --  [ LRM93 3.1.1 ]
    --  enumeration_literal ::= identifier | character_literal
-   function Parse_Enumeration_Type_Definition
-     return Iir_Enumeration_Type_Definition
+   function Parse_Enumeration_Type_Definition (Parent : Iir)
+      return Iir_Enumeration_Type_Definition
    is
       Pos: Iir_Int32;
       Enum_Lit: Iir_Enumeration_Literal;
       Enum_Type: Iir_Enumeration_Type_Definition;
       Enum_List : Iir_List;
    begin
-      -- This is an enumeration.
+      --  This is an enumeration.
       Enum_Type := Create_Iir (Iir_Kind_Enumeration_Type_Definition);
       Set_Location (Enum_Type);
       Enum_List := Create_Iir_List;
       Set_Enumeration_Literal_List (Enum_Type, Enum_List);
 
-      -- LRM93 3.1.1
-      -- The position number of the first listed enumeration literal is zero.
+      --  LRM93 3.1.1
+      --  The position number of the first listed enumeration literal is zero.
       Pos := 0;
-      -- scan every literal.
+
+      --  Eat '('.
       Scan;
+
       if Current_Token = Tok_Right_Paren then
          Error_Msg_Parse ("at least one literal must be declared");
          Scan;
@@ -1487,8 +1489,10 @@ package body Parse is
             end if;
             Error_Msg_Parse ("identifier or character expected");
          end if;
+
          Enum_Lit := Create_Iir (Iir_Kind_Enumeration_Literal);
          Set_Identifier (Enum_Lit, Current_Identifier);
+         Set_Parent (Enum_Lit, Parent);
          Set_Location (Enum_Lit);
          Set_Enum_Pos (Enum_Lit, Pos);
 
@@ -1499,21 +1503,26 @@ package body Parse is
 
          Append_Element (Enum_List, Enum_Lit);
 
-         -- next token.
+         --  Skip identifier or character.
          Scan;
+
          exit when Current_Token = Tok_Right_Paren;
          if Current_Token /= Tok_Comma then
             Error_Msg_Parse ("')' or ',' is expected after an enum literal");
          end if;
 
-         -- scan a literal.
+         --  Skip ','.
          Scan;
+
          if Current_Token = Tok_Right_Paren then
             Error_Msg_Parse ("extra ',' ignored");
             exit;
          end if;
       end loop;
+
+      --  Skip ')'.
       Scan;
+
       return Enum_Type;
    end Parse_Enumeration_Type_Definition;
 
@@ -1697,6 +1706,7 @@ package body Parse is
       while Current_Token /= Tok_End loop
          Unit := Create_Iir (Iir_Kind_Unit_Declaration);
          Set_Location (Unit);
+         Set_Parent (Unit, Parent);
          Set_Identifier (Unit, Current_Identifier);
 
          --  Skip identifier.
@@ -2002,7 +2012,7 @@ package body Parse is
       case Current_Token is
          when Tok_Left_Paren =>
             --  This is an enumeration.
-            Def := Parse_Enumeration_Type_Definition;
+            Def := Parse_Enumeration_Type_Definition (Parent);
             Decl := Null_Iir;
 
          when Tok_Range =>
@@ -2378,7 +2388,8 @@ package body Parse is
    --
    --  [ §4.2 ]
    --  subtype_declaration ::= SUBTYPE identifier IS subtype_indication ;
-   function Parse_Subtype_Declaration return Iir_Subtype_Declaration
+   function Parse_Subtype_Declaration (Parent : Iir)
+                                      return Iir_Subtype_Declaration
    is
       Decl: Iir_Subtype_Declaration;
       Def: Iir;
@@ -2387,10 +2398,15 @@ package body Parse is
 
       Scan_Expect (Tok_Identifier);
       Set_Identifier (Decl, Current_Identifier);
+      Set_Parent (Decl, Parent);
       Set_Location (Decl);
 
+      --  Skip identifier.
       Scan_Expect (Tok_Is);
+
+      --  Skip 'is'.
       Scan;
+
       Def := Parse_Subtype_Indication;
       Set_Subtype_Indication (Decl, Def);
 
@@ -3528,7 +3544,7 @@ package body Parse is
                   end case;
                end if;
             when Tok_Subtype =>
-               Decl := Parse_Subtype_Declaration;
+               Decl := Parse_Subtype_Declaration (Parent);
             when Tok_Nature =>
                Decl := Parse_Nature_Declaration;
             when Tok_Terminal =>
diff --git a/src/vhdl/post_sems.adb b/src/vhdl/post_sems.adb
index 78eda5015..2e42e4510 100644
--- a/src/vhdl/post_sems.adb
+++ b/src/vhdl/post_sems.adb
@@ -17,6 +17,7 @@
 --  02111-1307, USA.
 with Types; use Types;
 with Std_Names; use Std_Names;
+with Sem_Specs;
 with Ieee.Std_Logic_1164;
 with Ieee.Vital_Timing;
 with Flags; use Flags;
@@ -53,7 +54,8 @@ package body Post_Sems is
 
       --  Look for VITAL attributes.
       if Flag_Vital_Checks then
-         Value := Get_Attribute_Value_Chain (Lib_Unit);
+         Value := Get_Attribute_Value_Chain
+           (Sem_Specs.Get_Attribute_Value_Chain_Parent (Lib_Unit));
          while Value /= Null_Iir loop
             Spec := Get_Attribute_Specification (Value);
             Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Spec));
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index a7c0b4b44..3230bf0f8 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1383,6 +1383,7 @@ package body Sem_Decls is
                   St_Decl := Create_Iir (Iir_Kind_Subtype_Declaration);
                   Location_Copy (St_Decl, Decl);
                   Set_Identifier (St_Decl, Get_Identifier (Decl));
+                  Set_Parent (St_Decl, Get_Parent (Decl));
                   Set_Type (St_Decl, Def);
                   Set_Type_Declarator (Def, St_Decl);
                   Set_Chain (St_Decl, Get_Chain (Decl));
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index fb7562709..c93643024 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -31,6 +31,7 @@ with Sem_Expr; use Sem_Expr;
 with Sem_Stmts; use Sem_Stmts;
 with Sem_Decls; use Sem_Decls;
 with Sem_Assocs; use Sem_Assocs;
+with Sem_Specs;
 with Sem_Types;
 with Sem_Psl;
 with Xrefs; use Xrefs;
@@ -2497,7 +2498,6 @@ package body Sem_Names is
       Prefix : Iir;
       Value : Iir;
       Attr_Id : Name_Id;
-      Spec : Iir_Attribute_Specification;
    begin
       Prefix := Get_Named_Entity (Get_Prefix (Attr));
 
@@ -2544,12 +2544,7 @@ package body Sem_Names is
       end case;
 
       Attr_Id := Get_Identifier (Attr);
-      Value := Get_Attribute_Value_Chain (Prefix);
-      while Value /= Null_Iir loop
-         Spec := Get_Attribute_Specification (Value);
-         exit when Get_Identifier (Get_Attribute_Designator (Spec)) = Attr_Id;
-         Value := Get_Chain (Value);
-      end loop;
+      Value := Sem_Specs.Find_Attribute_Value (Prefix, Attr_Id);
       if Value = Null_Iir then
          Error_Msg_Sem
            (Disp_Node (Prefix) & " was not annotated with attribute '"
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index ca821b27e..7a6c180c8 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -15,7 +15,6 @@
 --  along with GHDL; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
-with Types; use Types;
 with Iirs_Utils; use Iirs_Utils;
 with Sem_Expr; use Sem_Expr;
 with Sem_Names; use Sem_Names;
@@ -113,16 +112,92 @@ package body Sem_Specs is
       return Tok_Invalid;
    end Get_Entity_Class_Kind;
 
+   --  Return the node containing the attribute_value_chain field for DECL.
+   --  This is the parent of the attribute specification, so in general this
+   --  is also the parent of the declaration, but there are exceptions...
+   function Get_Attribute_Value_Chain_Parent (Decl : Iir) return Iir
+   is
+      Parent : Iir;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Configuration_Declaration =>
+            --  LRM93 5.1
+            --  An attribute specification for an attribute of a design unit
+            --  [...] must appear immediately within the declarative part of
+            --  that design unit.
+            return Decl;
+         when Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            --  LRM93 5.1
+            --  Similarly, an attribute specification for an attribute of an
+            --  interface object of a design unit, subprogram, block statement
+            --  or package  must appear immediately within the declarative part
+            --  of that design unit, subprogram, block statement, or package.
+            Parent := Get_Parent (Decl);
+            case Get_Kind (Parent) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Block_Statement
+                 | Iir_Kind_Package_Declaration
+                 | Iir_Kind_Package_Instantiation_Declaration =>
+                  return Parent;
+               when Iir_Kind_Procedure_Declaration
+                 | Iir_Kind_Function_Declaration =>
+                  return Get_Subprogram_Body (Parent);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Kinds_Sequential_Statement =>
+            --  Sequential statements can be nested.
+            Parent := Get_Parent (Decl);
+            loop
+               if Get_Kind (Parent) not in Iir_Kinds_Sequential_Statement then
+                  return Parent;
+               end if;
+               Parent := Get_Parent (Parent);
+            end loop;
+         when others =>
+            --  This is also true for enumeration literals and physical units.
+            return Get_Parent (Decl);
+      end case;
+   end Get_Attribute_Value_Chain_Parent;
+
+   function Find_Attribute_Value (Ent : Iir; Id : Name_Id) return Iir
+   is
+      Attr_Value_Parent : constant Iir :=
+        Get_Attribute_Value_Chain_Parent (Ent);
+      Value : Iir;
+      Spec : Iir;
+      Attr_Decl : Iir;
+   begin
+      Value := Get_Attribute_Value_Chain (Attr_Value_Parent);
+      while Value /= Null_Iir loop
+         if Get_Designated_Entity (Value) = Ent then
+            Spec := Get_Attribute_Specification (Value);
+            Attr_Decl := Get_Attribute_Designator (Spec);
+            if Get_Identifier (Attr_Decl) = Id then
+               return Value;
+            end if;
+         end if;
+         Value := Get_Chain (Value);
+      end loop;
+      return Null_Iir;
+   end Find_Attribute_Value;
+
    --  Decorate DECL with attribute ATTR.
    --  If CHECK_CLASS is true, class of DECL must be class of ATTR, otherwise
    --   returns silently.
    --  If CHECK_DEFINED is true, DECL must not have been decorated, otherwise
    --   returns silently.
-   procedure Attribute_A_Decl
-     (Decl : Iir;
-      Attr : Iir_Attribute_Specification;
-      Check_Class : Boolean;
-      Check_Defined : Boolean)
+   procedure Attribute_A_Decl (Decl : Iir;
+                               Attr : Iir_Attribute_Specification;
+                               Check_Class : Boolean;
+                               Check_Defined : Boolean)
    is
       use Tokens;
       El : Iir_Attribute_Value;
@@ -131,6 +206,8 @@ package body Sem_Specs is
       --  Due to possible error, it is not required to be an attribute decl,
       --  it may be a simple name.
       Attr_Decl : Iir;
+
+      Attr_Chain_Parent : Iir;
    begin
       --  LRM93 5.1
       --  It is an error if the class of those names is not the same as that
@@ -159,7 +236,7 @@ package body Sem_Specs is
          return;
       end if;
 
-      --  LRM93 §5.1
+      --  LRM93 5.1
       --  An attribute specification for an attribute of a design unit
       --  (ie an entity declaration, an architecture, a configuration, or a
       --  package) must appear immediately within the declarative part of
@@ -187,41 +264,44 @@ package body Sem_Specs is
       --  Similarly, it is an error if two different attributes with the
       --  same simple name (wether predefined or user-defined) are both
       --  associated with a given named entity.
-      El := Get_Attribute_Value_Chain (Decl);
+      Attr_Chain_Parent := Get_Attribute_Value_Chain_Parent (Decl);
+      El := Get_Attribute_Value_Chain (Attr_Chain_Parent);
       while El /= Null_Iir loop
-         declare
-            El_Attr : constant Iir_Attribute_Declaration :=
-              Get_Named_Entity (Get_Attribute_Designator
-                                  (Get_Attribute_Specification (El)));
-         begin
-            if El_Attr = Attr_Decl then
-               if Get_Attribute_Specification (El) = Attr then
-                  --  Was already specified with the same attribute value.
-                  --  This is possible only in one case:
-                  --
-                  --    signal S1       : real;
-                  --    alias  S1_too   : real is S1;
-                  --    attribute ATTR : T1;
-                  --    attribute ATTR of ALL : signal is '1';
+         if Get_Designated_Entity (El) = Decl then
+            declare
+               El_Attr : constant Iir_Attribute_Declaration :=
+                 Get_Named_Entity (Get_Attribute_Designator
+                                     (Get_Attribute_Specification (El)));
+            begin
+               if El_Attr = Attr_Decl then
+                  if Get_Attribute_Specification (El) = Attr then
+                     --  Was already specified with the same attribute value.
+                     --  This is possible only in one case:
+                     --
+                     --    signal S1       : real;
+                     --    alias  S1_too   : real is S1;
+                     --    attribute ATTR : T1;
+                     --    attribute ATTR of ALL : signal is '1';
+                     return;
+                  end if;
+                  if Check_Defined then
+                     Error_Msg_Sem
+                       (Disp_Node (Decl) & " has already " & Disp_Node (Attr),
+                        Attr);
+                     Error_Msg_Sem ("previous attribute specification at "
+                                      & Disp_Location (El), Attr);
+                  end if;
                   return;
-               end if;
-               if Check_Defined then
+               elsif Get_Identifier (El_Attr) = Get_Identifier (Attr_Decl) then
                   Error_Msg_Sem
-                    (Disp_Node (Decl) & " has already " & Disp_Node (Attr),
-                     Attr);
-                  Error_Msg_Sem ("previous attribute specification at "
-                                 & Disp_Location (El), Attr);
+                    (Disp_Node (Decl) & " is already decorated with an "
+                       & Disp_Node (El_Attr), Attr);
+                  Error_Msg_Sem
+                    ("(previous attribute specification was here)", El);
+                  return;
                end if;
-               return;
-            elsif Get_Identifier (El_Attr) = Get_Identifier (Attr_Decl) then
-               Error_Msg_Sem
-                 (Disp_Node (Decl) & " is already decorated with an "
-                  & Disp_Node (El_Attr), Attr);
-               Error_Msg_Sem
-                 ("(previous attribute specification was here)", El);
-               return;
-            end if;
-         end;
+            end;
+         end if;
          El := Get_Chain (El);
       end loop;
 
@@ -243,11 +323,16 @@ package body Sem_Specs is
       Set_Designated_Entity (El, Decl);
       Set_Type (El, Get_Type (Attr_Decl));
       Set_Base_Name (El, El);
-      Set_Chain (El, Get_Attribute_Value_Chain (Decl));
-      Set_Attribute_Value_Chain (Decl, El);
+
+      --  Put the attribute value in the attribute_value_chain.
+      Set_Chain (El, Get_Attribute_Value_Chain (Attr_Chain_Parent));
+      Set_Attribute_Value_Chain (Attr_Chain_Parent, El);
+
+      --  Put the attribute value in the chain of the attribute specification.
       Set_Spec_Chain (El, Get_Attribute_Value_Spec_Chain (Attr));
       Set_Attribute_Value_Spec_Chain (Attr, El);
 
+      --  Special handling for 'Foreign.
       if (Flags.Vhdl_Std >= Vhdl_93c
           and then Attr_Decl = Foreign_Attribute)
         or else
@@ -620,8 +705,7 @@ package body Sem_Specs is
    end Sem_Signature_Entity_Designator;
 
    procedure Sem_Attribute_Specification
-     (Spec : Iir_Attribute_Specification;
-      Scope : Iir)
+     (Spec : Iir_Attribute_Specification; Scope : Iir)
    is
       use Tokens;
 
diff --git a/src/vhdl/sem_specs.ads b/src/vhdl/sem_specs.ads
index c27207b01..ba5c95fbd 100644
--- a/src/vhdl/sem_specs.ads
+++ b/src/vhdl/sem_specs.ads
@@ -15,10 +15,20 @@
 --  along with GHDL; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with Types; use Types;
 with Iirs; use Iirs;
 with Tokens;
 
 package Sem_Specs is
+   --  Return the attribute_value for named entity ENT and attribute identifier
+   --  ID.  Return Null_Iir if ENT was not decorated with attribute ID.
+   function Find_Attribute_Value (Ent : Iir; Id : Name_Id) return Iir;
+
+   --  Return the node containing the attribute_value_chain field for DECL.
+   --  This is the parent of the attribute specification, so in general this
+   --  is also the parent of the declaration, but there are exceptions...
+   function Get_Attribute_Value_Chain_Parent (Decl : Iir) return Iir;
+
    function Get_Entity_Class_Kind (Decl : Iir) return Tokens.Token_Type;
 
    procedure Sem_Attribute_Specification
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index b20f62218..977e01f00 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -24,6 +24,7 @@ with Errorout; use Errorout;
 with Name_Table; -- use Name_Table;
 with Iirs_Utils; use Iirs_Utils;
 with Std_Package; use Std_Package;
+with Sem_Specs;
 with Libraries;
 with Std_Names;
 with Trans;
@@ -65,21 +66,12 @@ package body Translation is
       use Name_Table;
       Attr : Iir_Attribute_Value;
       Spec : Iir_Attribute_Specification;
-      Attr_Decl : Iir;
       Expr : Iir;
    begin
       --  Look for 'FOREIGN.
-      Attr := Get_Attribute_Value_Chain (Decl);
-      while Attr /= Null_Iir loop
-         Spec := Get_Attribute_Specification (Attr);
-         Attr_Decl := Get_Attribute_Designator (Spec);
-         exit when Get_Identifier (Attr_Decl) = Std_Names.Name_Foreign;
-         Attr := Get_Chain (Attr);
-      end loop;
-      if Attr = Null_Iir then
-         --  Not found.
-         raise Internal_Error;
-      end if;
+      Attr := Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign);
+      pragma Assert (Attr /= Null_Iir);
+
       Spec := Get_Attribute_Specification (Attr);
       Expr := Get_Expression (Spec);
       case Get_Kind (Expr) is