Handle signal attribute in declarations. Fix alias of implicit signal.

8 files changed, 152 insertions, 120 deletions

diff --git a/src/vhdl/iir_chains.adb b/src/vhdl/iir_chains.adb
index ef47b64..d6d944f 100644
--- a/src/vhdl/iir_chains.adb
+++ b/src/vhdl/iir_chains.adb
@@ -36,6 +36,7 @@ package body Iir_Chains is
 
    procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir) is
    begin
+      pragma Assert (El /= Null_Iir);
       if First = Null_Iir then
          First := El;
       else
@@ -44,6 +45,18 @@ package body Iir_Chains is
       Last := El;
    end Sub_Chain_Append;
 
+   procedure Sub_Chain_Append_Chain (First, Last : in out Iir;
+                                     First_Sub, Last_Sub : Iir) is
+   begin
+      pragma Assert (First_Sub /= Null_Iir);
+      if First = Null_Iir then
+         First := First_Sub;
+      else
+         Set_Chain (Last, First_Sub);
+      end if;
+      Last := Last_Sub;
+   end Sub_Chain_Append_Chain;
+
    function Is_Chain_Length_One (Chain : Iir) return Boolean is
    begin
       return Chain /= Null_Iir and then Get_Chain (Chain) = Null_Iir;
diff --git a/src/vhdl/iir_chains.ads b/src/vhdl/iir_chains.ads
index dc2f389..9d61752 100644
--- a/src/vhdl/iir_chains.ads
+++ b/src/vhdl/iir_chains.ads
@@ -100,6 +100,11 @@ package Iir_Chains is
    procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir);
    pragma Inline (Sub_Chain_Append);
 
+   --  Append chain to the sub-chain.  FIRST_SUB and LAST_SUB must not be
+   --  Null_Iir.
+   procedure Sub_Chain_Append_Chain (First, Last : in out Iir;
+                                     First_Sub, Last_Sub : Iir);
+
    --  Return TRUE iff CHAIN is of length one, ie CHAIN is not NULL_IIR
    --  and chain (CHAIN) is NULL_IIR.
    function Is_Chain_Length_One (Chain : Iir) return Boolean;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index a53f206..d4e6090 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -37,6 +37,47 @@ with Xrefs; use Xrefs;
 use Iir_Chains;
 
 package body Sem_Decls is
+   --  Region that can declare signals.  Used to add implicit declarations.
+   Current_Signals_Region : Implicit_Signal_Declaration_Type :=
+     (Null_Iir, False, Null_Iir, Null_Iir);
+
+   procedure Push_Signals_Declarative_Part
+     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir) is
+   begin
+      Cell := Current_Signals_Region;
+      Current_Signals_Region := (Decls_Parent, False, Null_Iir, Null_Iir);
+   end Push_Signals_Declarative_Part;
+
+   procedure Pop_Signals_Declarative_Part
+     (Cell: in Implicit_Signal_Declaration_Type) is
+   begin
+      Current_Signals_Region := Cell;
+   end Pop_Signals_Declarative_Part;
+
+   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir) is
+   begin
+      --  There must be a declarative part for implicit signals.
+      pragma Assert (Current_Signals_Region.Decls_Parent /= Null_Iir);
+
+      --  Chain must be empty.
+      pragma Assert (Get_Chain (Sig) = Null_Iir);
+
+      if Current_Signals_Region.Decls_Analyzed then
+         --  Just append.
+         if Current_Signals_Region.Last_Implicit_Decl = Null_Iir then
+            --  No declarations.
+            Set_Declaration_Chain (Current_Signals_Region.Decls_Parent, Sig);
+         else
+            --  Append to the last declaration.
+            Set_Chain (Current_Signals_Region.Last_Implicit_Decl, Sig);
+         end if;
+         Current_Signals_Region.Last_Implicit_Decl := Sig;
+      else
+         Sub_Chain_Append (Current_Signals_Region.First_Implicit_Decl,
+                           Current_Signals_Region.Last_Implicit_Decl, Sig);
+      end if;
+   end Add_Declaration_For_Implicit_Signal;
+
    --  Emit an error if the type of DECL is a file type, access type,
    --  protected type or if a subelement of DECL is an access type.
    procedure Check_Signal_Type (Decl : Iir)
@@ -2729,10 +2770,15 @@ package body Sem_Decls is
 
    procedure Sem_Declaration_Chain (Parent : Iir)
    is
-      Decl: Iir;
-      Last_Decl : Iir;
+      Decl : Iir;
+      Next_Decl : Iir;
       Attr_Spec_Chain : Iir;
 
+      --  New declaration chain (declarations like implicit signals may be
+      --  added, some like aliases may mutate).
+      First_Decl : Iir;
+      Last_Decl : Iir;
+
       --  Used for list of identifiers in object declarations to get the type
       --  and default value for the following declarations.
       Last_Obj_Decl : Iir;
@@ -2752,7 +2798,7 @@ package body Sem_Decls is
 
       --  Due to implicit declarations, the list can grow during sem.
       Decl := Get_Declaration_Chain (Parent);
-      Last_Decl := Null_Iir;
+      Sub_Chain_Init (First_Decl, Last_Decl);
       Attr_Spec_Chain := Null_Iir;
       Last_Obj_Decl := Null_Iir;
 
@@ -2807,24 +2853,10 @@ package body Sem_Decls is
                --  existing attribute specification apply to them.
                null;
             when Iir_Kind_Object_Alias_Declaration =>
-               declare
-                  Res : Iir;
-               begin
-                  Res := Sem_Alias_Declaration (Decl);
-                  if Res /= Decl then
-                     --  Replace DECL with RES.
-                     if Last_Decl = Null_Iir then
-                        Set_Declaration_Chain (Parent, Res);
-                     else
-                        Set_Chain (Last_Decl, Res);
-                     end if;
-                     Decl := Res;
-
-                     --  An alias may add new alias declarations. Do not skip
-                     --  them: check that no existing attribute specifications
-                     --  apply to them.
-                  end if;
-               end;
+               Decl := Sem_Alias_Declaration (Decl);
+               --  An alias may add new alias declarations. Do not skip
+               --  them: check that no existing attribute specifications
+               --  apply to them.
             when Iir_Kind_Use_Clause =>
                Sem_Use_Clause (Decl);
             when Iir_Kind_Configuration_Specification =>
@@ -2855,9 +2887,30 @@ package body Sem_Decls is
          if Attr_Spec_Chain /= Null_Iir then
             Check_Post_Attribute_Specification (Attr_Spec_Chain, Decl);
          end if;
-         Last_Decl := Decl;
-         Decl := Get_Chain (Decl);
-      end  loop;
+
+         if Current_Signals_Region.Decls_Parent = Parent
+           and then Current_Signals_Region.First_Implicit_Decl /= Null_Iir
+         then
+            --  Add pending implicit declarations before the current one.
+            Sub_Chain_Append_Chain (First_Decl, Last_Decl,
+                                    Current_Signals_Region.First_Implicit_Decl,
+                                    Current_Signals_Region.Last_Implicit_Decl);
+            Sub_Chain_Init (Current_Signals_Region.First_Implicit_Decl,
+                            Current_Signals_Region.Last_Implicit_Decl);
+         end if;
+
+         Next_Decl := Get_Chain (Decl);
+         Sub_Chain_Append (First_Decl, Last_Decl, Decl);
+         Decl := Next_Decl;
+      end loop;
+      Set_Declaration_Chain (Parent, First_Decl);
+
+      if Current_Signals_Region.Decls_Parent = Parent then
+         --  All declarations have been analyzed, new implicit declarations
+         --  will be appended.
+         Current_Signals_Region.Decls_Analyzed := True;
+         Current_Signals_Region.Last_Implicit_Decl := Last_Decl;
+      end if;
    end Sem_Declaration_Chain;
 
    procedure Check_Full_Declaration (Decls_Parent : Iir; Decl: Iir)
diff --git a/src/vhdl/sem_decls.ads b/src/vhdl/sem_decls.ads
index 7a8e240..49ba43a 100644
--- a/src/vhdl/sem_decls.ads
+++ b/src/vhdl/sem_decls.ads
@@ -18,6 +18,7 @@
 with Iirs; use Iirs;
 
 package Sem_Decls is
+   --  Analyze an interface chain.
    procedure Sem_Interface_Chain (Interface_Chain: Iir;
                                   Interface_Kind : Interface_Kind_Type);
 
@@ -49,4 +50,45 @@ package Sem_Decls is
    --  is an overload list, it is destroyed.
    function Sem_Signature (Name : Iir; Sig : Iir_Signature) return Iir;
 
+   --  The attribute signals ('stable, 'quiet and 'transaction) are
+   --  implicitely declared.
+   --  Note: guard signals are also implicitly declared but with a guard
+   --   expression, which is at a known location.
+   --  Since these signals need resources and are not easily located (can be
+   --  nearly in every expression), it is useful to add a node into a
+   --  declaration list to declare them.
+   --  However, only a few declaration_list can declare signals.  These
+   --  declarations lists must register and unregister themselves with
+   --  push_declarative_region_with_signals and
+   --  pop_declarative_region_with_signals.
+   type Implicit_Signal_Declaration_Type is private;
+
+   procedure Push_Signals_Declarative_Part
+     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir);
+
+   procedure Pop_Signals_Declarative_Part
+     (Cell: in Implicit_Signal_Declaration_Type);
+
+   --  Declare an implicit signal.
+   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir);
+
+private
+   type Implicit_Signal_Declaration_Type is record
+      --  Declaration or statement than will contain implicit declarations.
+      Decls_Parent : Iir;
+
+      --  If True, declarations of DECLS_PARENT have already been analyzed.
+      --  So implicit declarations are appended to the parent, and the last
+      --  declaration is LAST_IMPLICIT_DECL.
+      --  If False, declarations are being analyzed.  Implicit declarations
+      --  are saved in FIRST_IMPLICIT_DECL / LAST_IMPLICIT_DECL and will be
+      --  inserted before the current declaration.
+      Decls_Analyzed : Boolean;
+
+      --  If DECLS_ANALYZED is False, this is the chain of implicit
+      --  declarations.  If True, LAST_IMPLICIT_DECL contains the last
+      --  declaration.
+      First_Implicit_Decl : Iir;
+      Last_Implicit_Decl : Iir;
+   end record;
 end Sem_Decls;
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 4ab2390..d6e3422 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -3040,7 +3040,7 @@ package body Sem_Names is
                null;
          end case;
       end if;
-      Sem_Stmts.Add_Declaration_For_Implicit_Signal (Res);
+      Sem_Decls.Add_Declaration_For_Implicit_Signal (Res);
       return Res;
    end Sem_Signal_Signal_Attribute;
 
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index e4c8996..fdc590d 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -57,46 +57,6 @@ package body Sem_Stmts is
       return Current_Concurrent_Statement;
    end Get_Current_Concurrent_Statement;
 
-   Current_Declarative_Region_With_Signals :
-     Implicit_Signal_Declaration_Type := (Null_Iir, Null_Iir);
-
-   procedure Push_Signals_Declarative_Part
-     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir) is
-   begin
-      Cell := Current_Declarative_Region_With_Signals;
-      Current_Declarative_Region_With_Signals := (Decls_Parent, Null_Iir);
-   end Push_Signals_Declarative_Part;
-
-   procedure Pop_Signals_Declarative_Part
-     (Cell: in Implicit_Signal_Declaration_Type) is
-   begin
-      Current_Declarative_Region_With_Signals := Cell;
-   end Pop_Signals_Declarative_Part;
-
-   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir)
-   is
-      Last : Iir renames
-        Current_Declarative_Region_With_Signals.Last_Decl;
-   begin
-      if Current_Declarative_Region_With_Signals.Decls_Parent = Null_Iir then
-         raise Internal_Error;
-      end if;
-      if Last = Null_Iir then
-         Last := Get_Declaration_Chain
-           (Current_Declarative_Region_With_Signals.Decls_Parent);
-      end if;
-      if Last = Null_Iir then
-         Set_Declaration_Chain
-           (Current_Declarative_Region_With_Signals.Decls_Parent, Sig);
-      else
-         while Get_Chain (Last) /= Null_Iir loop
-            Last := Get_Chain (Last);
-         end loop;
-         Set_Chain (Last, Sig);
-      end if;
-      Last := Sig;
-   end Add_Declaration_For_Implicit_Signal;
-
    --  LRM 8 Sequential statements.
    --  All statements may be labeled.
    --  Such labels are implicitly declared at the beginning of the declarative
diff --git a/src/vhdl/sem_stmts.ads b/src/vhdl/sem_stmts.ads
index d3eeb8c..5c4b7cf 100644
--- a/src/vhdl/sem_stmts.ads
+++ b/src/vhdl/sem_stmts.ads
@@ -27,28 +27,6 @@ package Sem_Stmts is
    --  Analyze the concurrent statements of PARENT.
    procedure Sem_Concurrent_Statement_Chain (Parent : Iir);
 
-   --  Some signals are implicitly declared.  This is the case for signals
-   --  declared by an attribute ('stable, 'quiet and 'transaction).
-   --  Note: guard signals are also implicitly declared, but with a guard
-   --   expression, which is located.
-   --  Since these signals need resources and are not easily located (can be
-   --  nearly in every expression), it is useful to add a node into a
-   --  declaration list to declare them.
-   --  However, only a few declaration_list can declare signals.  These
-   --  declarations lists must register and unregister themselves with
-   --  push_declarative_region_with_signals and
-   --  pop_declarative_region_with_signals.
-   type Implicit_Signal_Declaration_Type is private;
-
-   procedure Push_Signals_Declarative_Part
-     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir);
-
-   procedure Pop_Signals_Declarative_Part
-     (Cell: in Implicit_Signal_Declaration_Type);
-
-   -- Declare an implicit signal.
-   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir);
-
    --  Semantize declaration chain and sequential statement chain
    --  of BODY_PARENT.
    --  DECL is the declaration for these chains (DECL is the declaration, which
@@ -78,10 +56,4 @@ package Sem_Stmts is
    --    The current statement list does not belong to a process,
    --    SIG is a formal signal interface.
    procedure Sem_Add_Driver (Sig : Iir; Stmt : Iir);
-private
-   type Implicit_Signal_Declaration_Type is record
-      Decls_Parent : Iir;
-      Last_Decl : Iir;
-   end record;
-
 end Sem_Stmts;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 3cbfc0b..2e33033 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -172,22 +172,17 @@ package body Trans.Chap4 is
 
    procedure Create_Implicit_Signal (Decl : Iir)
    is
-      Sig_Type     : O_Tnode;
-      Type_Info    : Type_Info_Acc;
+      Sig_Type_Def : constant Iir := Get_Type (Decl);
+      Type_Info    : constant Type_Info_Acc := Get_Info (Sig_Type_Def);
+      Sig_Type     : constant O_Tnode := Type_Info.Ortho_Type (Mode_Signal);
       Info         : Ortho_Info_Acc;
-      Sig_Type_Def : Iir;
    begin
-      Sig_Type_Def := Get_Type (Decl);
       --  This has been disabled since DECL can have an anonymous subtype,
       --  and DECL has no identifiers, which causes translate_object_subtype
       --  to crash.
       --  Note: DECL can only be a iir_kind_delayed_attribute.
       --Chap3.Translate_Object_Subtype (Decl);
-      Type_Info := Get_Info (Sig_Type_Def);
-      Sig_Type := Type_Info.Ortho_Type (Mode_Signal);
-      if Sig_Type = O_Tnode_Null then
-         raise Internal_Error;
-      end if;
+      pragma Assert (Sig_Type /= O_Tnode_Null);
 
       Info := Add_Info (Decl, Kind_Object);
 
@@ -1401,21 +1396,19 @@ package body Trans.Chap4 is
    procedure Translate_Object_Alias_Declaration
      (Decl : Iir_Object_Alias_Declaration)
    is
-      Decl_Type : Iir;
+      Decl_Type : constant Iir := Get_Type (Decl);
       Info      : Alias_Info_Acc;
       Tinfo     : Type_Info_Acc;
       Atype     : O_Tnode;
    begin
-      Decl_Type := Get_Type (Decl);
-
-      Chap3.Translate_Named_Type_Definition
-        (Decl_Type, Get_Identifier (Decl));
+      Chap3.Translate_Named_Type_Definition (Decl_Type, Get_Identifier (Decl));
 
       Info := Add_Info (Decl, Kind_Alias);
       case Get_Kind (Get_Object_Prefix (Decl)) is
          when Iir_Kind_Signal_Declaration
-            | Iir_Kind_Interface_Signal_Declaration
-            | Iir_Kind_Guard_Signal_Declaration =>
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kinds_Signal_Attribute =>
             Info.Alias_Kind := Mode_Signal;
          when others =>
             Info.Alias_Kind := Mode_Value;
@@ -1454,24 +1447,18 @@ package body Trans.Chap4 is
    procedure Elab_Object_Alias_Declaration
      (Decl : Iir_Object_Alias_Declaration)
    is
-      Decl_Type  : Iir;
-      Name       : Iir;
+      Decl_Type  : constant Iir := Get_Type (Decl);
+      Tinfo      : constant Type_Info_Acc := Get_Info (Decl_Type);
+      Name       : constant Iir := Get_Name (Decl);
+      Name_Type  : constant Iir := Get_Type (Name);
+      Alias_Info : constant Alias_Info_Acc := Get_Info (Decl);
       Name_Node  : Mnode;
       Alias_Node : Mnode;
-      Alias_Info : Alias_Info_Acc;
-      Name_Type  : Iir;
-      Tinfo      : Type_Info_Acc;
       Kind       : Object_Kind_Type;
    begin
       New_Debug_Line_Stmt (Get_Line_Number (Decl));
 
-      Decl_Type := Get_Type (Decl);
-      Tinfo := Get_Info (Decl_Type);
-
-      Alias_Info := Get_Info (Decl);
       Chap3.Elab_Object_Subtype (Decl_Type);
-      Name := Get_Name (Decl);
-      Name_Type := Get_Type (Name);
       Name_Node := Chap6.Translate_Name (Name);
       Kind := Get_Object_Kind (Name_Node);