Create src/vhdl subdirectory.

1 files changed, 0 insertions, 1113 deletions

diff --git a/src/errorout.adb b/src/errorout.adb
deleted file mode 100644
index 1652bb43e..000000000
--- a/src/errorout.adb
+++ /dev/null
@@ -1,1113 +0,0 @@
---  Error message handling.
---  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  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 Ada.Text_IO;
-with Ada.Command_Line;
-with Scanner;
-with Tokens; use Tokens;
-with Name_Table;
-with Iirs_Utils; use Iirs_Utils;
-with Files_Map; use Files_Map;
-with Ada.Strings.Unbounded;
-with Std_Names;
-with Flags;
-with PSL.Nodes;
-
-package body Errorout is
-   procedure Put (Str : String)
-   is
-      use Ada.Text_IO;
-   begin
-      Put (Standard_Error, Str);
-   end Put;
-
-   procedure Put (C : Character)
-   is
-      use Ada.Text_IO;
-   begin
-      Put (Standard_Error, C);
-   end Put;
-
-   procedure Put_Line (Str : String)
-   is
-      use Ada.Text_IO;
-   begin
-      Put_Line (Standard_Error, Str);
-   end Put_Line;
-
-   procedure Disp_Natural (Val: Natural)
-   is
-      Str: constant String := Natural'Image (Val);
-   begin
-      Put (Str(Str'First + 1 .. Str'Last));
-   end Disp_Natural;
-
-   procedure Error_Msg (Msg: String) is
-   begin
-      Put (Ada.Command_Line.Command_Name);
-      Put (": ");
-      Put_Line (Msg);
-   end Error_Msg;
-
-   procedure Error_Kind (Msg : String; An_Iir : Iir) is
-   begin
-      Put_Line (Msg & ": cannot handle "
-                & Iir_Kind'Image (Get_Kind (An_Iir))
-                & " (" & Disp_Location (An_Iir) & ')');
-      raise Internal_Error;
-   end Error_Kind;
-
-   procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is
-   begin
-      Put_Line (Msg & ": cannot handle "
-                & Iir_Predefined_Functions'Image (Def));
-      raise Internal_Error;
-   end Error_Kind;
-
-   procedure Error_Kind (Msg : String; N : PSL_Node) is
-   begin
-      Put (Msg);
-      Put (": cannot handle ");
-      Put_Line (PSL.Nodes.Nkind'Image (PSL.Nodes.Get_Kind (N)));
-      raise Internal_Error;
-   end Error_Kind;
-
-   procedure Error_Msg_Option_NR (Msg: String) is
-   begin
-      Put (Ada.Command_Line.Command_Name);
-      Put (": ");
-      Put_Line (Msg);
-   end Error_Msg_Option_NR;
-
-   procedure Error_Msg_Option (Msg: String) is
-   begin
-      Error_Msg_Option_NR (Msg);
-      raise Option_Error;
-   end Error_Msg_Option;
-
-   procedure Disp_Location
-     (File: Name_Id; Line: Natural; Col: Natural) is
-   begin
-      Put (Name_Table.Image (File));
-      Put (':');
-      Disp_Natural (Line);
-      Put (':');
-      Disp_Natural (Col);
-      Put (':');
-   end Disp_Location;
-
-   procedure Disp_Current_Location is
-   begin
-      Disp_Location (Scanner.Get_Current_File,
-                     Scanner.Get_Current_Line,
-                     Scanner.Get_Current_Column);
-   end Disp_Current_Location;
-
-   procedure Disp_Token_Location is
-   begin
-      Disp_Location (Scanner.Get_Current_File,
-                     Scanner.Get_Current_Line,
-                     Scanner.Get_Token_Column);
-   end Disp_Token_Location;
-
-   procedure Disp_Location (Loc : Location_Type)
-   is
-      Name : Name_Id;
-      Line : Natural;
-      Col : Natural;
-   begin
-      if Loc = Location_Nil then
-         --  Avoid a crash, but should not happen.
-         Put ("??:??:??:");
-      else
-         Location_To_Position (Loc, Name, Line, Col);
-         Disp_Location (Name, Line, Col);
-      end if;
-   end Disp_Location;
-
-   function Get_Location_Safe (N : Iir) return Location_Type is
-   begin
-      if N = Null_Iir then
-         return Location_Nil;
-      else
-         return Get_Location (N);
-      end if;
-   end Get_Location_Safe;
-
-   procedure Disp_Iir_Location (An_Iir: Iir) is
-   begin
-      Disp_Location (Get_Location_Safe (An_Iir));
-   end Disp_Iir_Location;
-
-   procedure Disp_PSL_Location (N : PSL_Node) is
-   begin
-      Disp_Location (PSL.Nodes.Get_Location (N));
-   end Disp_PSL_Location;
-
-   procedure Warning_Msg (Msg: String) is
-   begin
-      Put ("warning: ");
-      Put_Line (Msg);
-   end Warning_Msg;
-
-   procedure Warning_Msg_Parse (Msg: String) is
-   begin
-      if Flags.Flag_Only_Elab_Warnings then
-         return;
-      end if;
-      Disp_Token_Location;
-      if Flags.Warn_Error then
-         Nbr_Errors := Nbr_Errors + 1;
-         Put (" ");
-      else
-         Put ("warning: ");
-      end if;
-      Put_Line (Msg);
-   end Warning_Msg_Parse;
-
-   procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is
-   begin
-      if Flags.Flag_Only_Elab_Warnings then
-         return;
-      end if;
-      Disp_Location (Loc);
-      if Flags.Warn_Error then
-         Nbr_Errors := Nbr_Errors + 1;
-         Put (" ");
-      else
-         Put ("warning: ");
-      end if;
-      Put_Line (Msg);
-   end Warning_Msg_Sem;
-
-   procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is
-   begin
-      Warning_Msg_Sem (Msg, Get_Location_Safe (Loc));
-   end Warning_Msg_Sem;
-
-   procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is
-   begin
-      Disp_Location (Loc);
-      if Flags.Warn_Error then
-         Nbr_Errors := Nbr_Errors + 1;
-         Put (" ");
-      else
-         Put ("warning: ");
-      end if;
-      Put_Line (Msg);
-   end Warning_Msg_Elab;
-
-   procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is
-   begin
-      Warning_Msg_Elab (Msg, Get_Location_Safe (Loc));
-   end Warning_Msg_Elab;
-
-   procedure Disp_Current_Token;
-   pragma Unreferenced (Disp_Current_Token);
-
-   procedure Disp_Current_Token is
-   begin
-      case Scanner.Current_Token is
-         when Tok_Identifier =>
-            Put ("identifier """
-                 & Name_Table.Image (Scanner.Current_Identifier) & """");
-         when others =>
-            Put (Token_Type'Image (Scanner.Current_Token));
-      end case;
-   end Disp_Current_Token;
-
-   -- Disp a message during scan.
-   procedure Error_Msg_Scan (Msg: String) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Current_Location;
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Scan;
-
-   procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Location (Loc);
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Scan;
-
-   -- Disp a message during scan.
-   procedure Warning_Msg_Scan (Msg: String) is
-   begin
-      Disp_Current_Location;
-      Put ("warning: ");
-      Put_Line (Msg);
-   end Warning_Msg_Scan;
-
-   -- Disp a message during scan.
-   procedure Error_Msg_Parse (Msg: String) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Token_Location;
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Parse;
-
-   procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Iir_Location (Loc);
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Parse;
-
-   procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Location (Loc);
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Parse;
-
-   -- Disp a message during semantic analysis.
-   -- LOC is used for location and current token.
-   procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      if Loc /= Null_Iir then
-         Disp_Iir_Location (Loc);
-         Put (' ');
-      end if;
-      Put_Line (Msg);
-   end Error_Msg_Sem;
-
-   procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node) is
-      use PSL.Nodes;
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      if Loc /= Null_Node then
-         Disp_PSL_Location (Loc);
-         Put (' ');
-      end if;
-      Put_Line (Msg);
-   end Error_Msg_Sem;
-
-   procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Location (Loc);
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Sem;
-
-   -- Disp a message during elaboration.
-   procedure Error_Msg_Elab (Msg: String) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Put ("error: ");
-      Put_Line (Msg);
-   end Error_Msg_Elab;
-
-   procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
-   begin
-      Nbr_Errors := Nbr_Errors + 1;
-      Disp_Iir_Location (Loc);
-      Put (' ');
-      Put_Line (Msg);
-   end Error_Msg_Elab;
-
-   -- Disp a bug message.
-   procedure Error_Internal (Expr: in Iir; Msg: String := "")
-   is
-      pragma Unreferenced (Expr);
-   begin
-      Put ("internal error: ");
-      Put_Line (Msg);
-      raise Internal_Error;
-   end Error_Internal;
-
-   function Disp_Label (Node : Iir; Str : String) return String
-   is
-      Id : Name_Id;
-   begin
-      Id := Get_Label (Node);
-      if Id = Null_Identifier then
-         return "(unlabeled) " & Str;
-      else
-         return Str & " labeled """ & Name_Table.Image (Id) & """";
-      end if;
-   end Disp_Label;
-
-   -- Disp a node.
-   -- Used for output of message.
-   function Disp_Node (Node: Iir) return String is
-      function Disp_Identifier (Node : Iir; Str : String) return String
-      is
-         Id : Name_Id;
-      begin
-         Id := Get_Identifier (Node);
-         return Str & " """ & Name_Table.Image (Id) & """";
-      end Disp_Identifier;
-
-      function Disp_Type (Node : Iir; Str : String) return String
-      is
-         Decl: Iir;
-      begin
-         Decl := Get_Type_Declarator (Node);
-         if Decl = Null_Iir then
-            return "the anonymous " & Str
-              & " defined at " & Disp_Location (Node);
-         else
-            return Disp_Identifier (Decl, Str);
-         end if;
-      end Disp_Type;
-
-   begin
-      case Get_Kind (Node) is
-         when Iir_Kind_String_Literal =>
-            return "string literal """
-              & Image_String_Lit (Node) & """";
-         when Iir_Kind_Bit_String_Literal =>
-            return "bit string literal """
-              & Image_String_Lit (Node) & """";
-         when Iir_Kind_Character_Literal =>
-            return "character literal " & Image_Identifier (Node);
-         when Iir_Kind_Integer_Literal =>
-            return "integer literal";
-         when Iir_Kind_Floating_Point_Literal =>
-            return "floating point literal";
-         when Iir_Kind_Physical_Int_Literal
-           | Iir_Kind_Physical_Fp_Literal =>
-            return "physical literal";
-         when Iir_Kind_Enumeration_Literal =>
-            return "enumeration literal " & Image_Identifier (Node);
-         when Iir_Kind_Element_Declaration =>
-            return Disp_Identifier (Node, "element");
-         when Iir_Kind_Record_Element_Constraint =>
-            return "record element constraint";
-         when Iir_Kind_Array_Element_Resolution =>
-            return "array element resolution";
-         when Iir_Kind_Record_Resolution =>
-            return "record resolution";
-         when Iir_Kind_Record_Element_Resolution =>
-            return "record element resolution";
-         when Iir_Kind_Null_Literal =>
-            return "null literal";
-         when Iir_Kind_Overflow_Literal =>
-            return Disp_Node (Get_Literal_Origin (Node));
-         when Iir_Kind_Aggregate =>
-            return "aggregate";
-         when Iir_Kind_Unit_Declaration =>
-            return Disp_Identifier (Node, "physical unit");
-         when Iir_Kind_Simple_Aggregate =>
-            return "locally static array literal";
-
-         when Iir_Kind_Operator_Symbol =>
-            return "operator name";
-         when Iir_Kind_Aggregate_Info =>
-            return "aggregate info";
-         when Iir_Kind_Signature =>
-            return "signature";
-         when Iir_Kind_Waveform_Element =>
-            return "waveform element";
-         when Iir_Kind_Conditional_Waveform =>
-            return "conditional waveform";
-         when Iir_Kind_Association_Element_Open =>
-            return "open association element";
-         when Iir_Kind_Association_Element_By_Individual =>
-            return "individual association element";
-         when Iir_Kind_Association_Element_By_Expression
-           | Iir_Kind_Association_Element_Package =>
-            return "association element";
-         when Iir_Kind_Overload_List =>
-            return "overloaded name or expression";
-
-         when Iir_Kind_Integer_Type_Definition
-           | Iir_Kind_Enumeration_Type_Definition =>
-            return Image_Identifier (Get_Type_Declarator (Node));
-         when Iir_Kind_Array_Type_Definition =>
-            return Disp_Type (Node, "array type");
-         when Iir_Kind_Array_Subtype_Definition =>
-            return Disp_Type (Node, "array subtype");
-         when Iir_Kind_Record_Type_Definition =>
-            return Disp_Type (Node, "record type");
-         when Iir_Kind_Record_Subtype_Definition =>
-            return Disp_Type (Node, "record subtype");
-         when Iir_Kind_Enumeration_Subtype_Definition =>
-            return Disp_Type (Node, "enumeration subtype");
-         when Iir_Kind_Integer_Subtype_Definition =>
-            return Disp_Type (Node, "integer subtype");
-         when Iir_Kind_Physical_Type_Definition =>
-            return Disp_Type (Node, "physical type");
-         when Iir_Kind_Physical_Subtype_Definition =>
-            return Disp_Type (Node, "physical subtype");
-         when Iir_Kind_File_Type_Definition =>
-            return Disp_Type (Node, "file type");
-         when Iir_Kind_Access_Type_Definition =>
-            return Disp_Type (Node, "access type");
-         when Iir_Kind_Access_Subtype_Definition =>
-            return Disp_Type (Node, "access subtype");
-         when Iir_Kind_Floating_Subtype_Definition
-           | Iir_Kind_Floating_Type_Definition =>
-            return Disp_Type (Node, "floating type");
-         when Iir_Kind_Incomplete_Type_Definition =>
-            return Disp_Type (Node, "incomplete type");
-         when Iir_Kind_Protected_Type_Declaration =>
-            return Disp_Type (Node, "protected type");
-         when Iir_Kind_Protected_Type_Body =>
-            return Disp_Type (Node, "protected type body");
-         when Iir_Kind_Subtype_Definition =>
-            return "subtype definition";
-
-         when Iir_Kind_Scalar_Nature_Definition =>
-            return Image_Identifier (Get_Nature_Declarator (Node));
-
-         when Iir_Kind_Choice_By_Expression =>
-            return "choice by expression";
-         when Iir_Kind_Choice_By_Range =>
-            return "choice by range";
-         when Iir_Kind_Choice_By_Name =>
-            return "choice by name";
-         when Iir_Kind_Choice_By_Others =>
-            return "others choice";
-         when Iir_Kind_Choice_By_None =>
-            return "positionnal choice";
-
-         when Iir_Kind_Function_Call =>
-            return "function call";
-         when Iir_Kind_Procedure_Call_Statement =>
-            return "procedure call statement";
-         when Iir_Kind_Procedure_Call =>
-            return "procedure call";
-         when Iir_Kind_Selected_Name =>
-            Name_Table.Image (Get_Identifier (Node));
-            return '''
-              & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)
-              & ''';
-         when Iir_Kind_Simple_Name =>
-            Name_Table.Image (Get_Identifier (Node));
-            return '''
-              & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)
-              & ''';
-         when Iir_Kind_Entity_Aspect_Entity =>
-            return "aspect " & Disp_Node (Get_Entity (Node))
-              & '(' & Image_Identifier (Get_Architecture (Node)) & ')';
-         when Iir_Kind_Entity_Aspect_Configuration =>
-            return "configuration entity aspect";
-         when Iir_Kind_Entity_Aspect_Open =>
-            return "open entity aspect";
-
-         when Iir_Kinds_Monadic_Operator
-           | Iir_Kinds_Dyadic_Operator =>
-            return "operator """
-              & Name_Table.Image (Get_Operator_Name (Node)) & """";
-         when Iir_Kind_Parenthesis_Expression =>
-            return "expression";
-         when Iir_Kind_Qualified_Expression =>
-            return "qualified expression";
-         when Iir_Kind_Type_Conversion =>
-            return "type conversion";
-         when Iir_Kind_Allocator_By_Subtype
-           | Iir_Kind_Allocator_By_Expression =>
-            return "allocator";
-         when Iir_Kind_Indexed_Name =>
-            return "indexed name";
-         when Iir_Kind_Range_Expression =>
-            return "range expression";
-         when Iir_Kind_Implicit_Dereference =>
-            return "implicit access dereference";
-         when Iir_Kind_Dereference =>
-            return "access dereference";
-         when Iir_Kind_Selected_Element =>
-            return "selected element";
-         when Iir_Kind_Selected_By_All_Name =>
-            return ".all name";
-         when Iir_Kind_Psl_Expression =>
-            return "PSL instantiation";
-
-         when Iir_Kind_Interface_Constant_Declaration =>
-            if Get_Parent (Node) = Null_Iir then
-               --  For constant interface of predefined operator.
-               return "anonymous interface";
-            end if;
-            case Get_Kind (Get_Parent (Node)) is
-               when Iir_Kind_Entity_Declaration
-                 | Iir_Kind_Block_Statement
-                 | Iir_Kind_Block_Header =>
-                  return Disp_Identifier (Node, "generic");
-               when others =>
-                  return Disp_Identifier (Node, "constant interface");
-            end case;
-         when Iir_Kind_Interface_Signal_Declaration =>
-            case Get_Kind (Get_Parent (Node)) is
-               when Iir_Kind_Entity_Declaration
-                 | Iir_Kind_Block_Statement
-                 | Iir_Kind_Block_Header =>
-                  return Disp_Identifier (Node, "port");
-               when others =>
-                  return Disp_Identifier (Node, "signal interface");
-            end case;
-         when Iir_Kind_Interface_Variable_Declaration =>
-            return Disp_Identifier (Node, "variable interface");
-         when Iir_Kind_Interface_File_Declaration =>
-            return Disp_Identifier (Node, "file interface");
-         when Iir_Kind_Interface_Package_Declaration =>
-            return Disp_Identifier (Node, "package interface");
-         when Iir_Kind_Signal_Declaration =>
-            return Disp_Identifier (Node, "signal");
-         when Iir_Kind_Variable_Declaration =>
-            return Disp_Identifier (Node, "variable");
-         when Iir_Kind_Iterator_Declaration
-           | Iir_Kind_Constant_Declaration =>
-            return Disp_Identifier (Node, "constant");
-         when Iir_Kind_File_Declaration =>
-            return Disp_Identifier (Node, "file");
-         when Iir_Kind_Object_Alias_Declaration =>
-            return Disp_Identifier (Node, "alias");
-         when Iir_Kind_Non_Object_Alias_Declaration =>
-            return Disp_Identifier (Node, "non-object alias");
-         when Iir_Kind_Guard_Signal_Declaration =>
-            return "GUARD signal";
-         when Iir_Kind_Group_Template_Declaration =>
-            return Disp_Identifier (Node, "group template");
-         when Iir_Kind_Group_Declaration =>
-            return Disp_Identifier (Node, "group");
-
-         when Iir_Kind_Library_Declaration
-           | Iir_Kind_Library_Clause =>
-            return Disp_Identifier (Node, "library");
-         when Iir_Kind_Design_File =>
-            return "design file";
-
-         when Iir_Kind_Procedure_Declaration =>
-            return Disp_Identifier (Node, "procedure");
-         when Iir_Kind_Procedure_Body
-           | Iir_Kind_Function_Body =>
-            return "subprogram body";
-         when Iir_Kind_Function_Declaration =>
-            return Disp_Identifier (Node, "function");
-
-         when Iir_Kind_Package_Declaration =>
-            return Disp_Identifier (Node, "package");
-         when Iir_Kind_Package_Body =>
-            return Disp_Identifier (Node, "package body");
-         when Iir_Kind_Entity_Declaration =>
-            return Disp_Identifier (Node, "entity");
-         when Iir_Kind_Architecture_Body =>
-            return Disp_Identifier (Node, "architecture") &
-              " of" & Disp_Identifier (Get_Entity_Name (Node), "");
-         when Iir_Kind_Configuration_Declaration =>
-            declare
-               Id : Name_Id;
-               Ent : Iir;
-               Arch : Iir;
-            begin
-               Id := Get_Identifier (Node);
-               if Id /= Null_Identifier then
-                  return Disp_Identifier (Node, "configuration");
-               else
-                  Ent := Get_Entity (Node);
-                  Arch := Get_Block_Specification
-                    (Get_Block_Configuration (Node));
-                  return "default configuration of "
-                    & Image_Identifier (Ent)
-                    & '(' & Image_Identifier (Arch) & ')';
-               end if;
-            end;
-         when Iir_Kind_Package_Instantiation_Declaration =>
-            return Disp_Identifier (Node, "instantiation package");
-
-         when Iir_Kind_Package_Header =>
-            return "package header";
-
-         when Iir_Kind_Component_Declaration =>
-            return Disp_Identifier (Node, "component");
-
-         when Iir_Kind_Design_Unit =>
-            return Disp_Node (Get_Library_Unit (Node));
-         when Iir_Kind_Use_Clause =>
-            return "use clause";
-         when Iir_Kind_Disconnection_Specification =>
-            return "disconnection specification";
-
-         when Iir_Kind_Slice_Name =>
-            return "slice";
-         when Iir_Kind_Parenthesis_Name =>
-            return "function call, slice or indexed name";
-         when Iir_Kind_Type_Declaration =>
-            return Disp_Identifier (Node, "type");
-         when Iir_Kind_Anonymous_Type_Declaration =>
-            return Disp_Identifier (Node, "type");
-         when Iir_Kind_Subtype_Declaration =>
-            return Disp_Identifier (Node, "subtype");
-
-         when Iir_Kind_Nature_Declaration =>
-            return Disp_Identifier (Node, "nature");
-         when Iir_Kind_Subnature_Declaration =>
-            return Disp_Identifier (Node, "subnature");
-
-         when Iir_Kind_Component_Instantiation_Statement =>
-            return Disp_Identifier (Node, "component instance");
-         when Iir_Kind_Configuration_Specification =>
-            return "configuration specification";
-         when Iir_Kind_Component_Configuration =>
-            return "component configuration";
-         when Iir_Kind_Implicit_Function_Declaration =>
-            return Disp_Identifier (Node, "implicit function")
-              & Disp_Identifier (Get_Type_Reference (Node), " of type");
---             return "implicit function "
---               & Get_Predefined_Function_Name
---                (Get_Implicit_Definition (Node));
-         when Iir_Kind_Implicit_Procedure_Declaration =>
-            return "implicit procedure "
-              & Get_Predefined_Function_Name (Get_Implicit_Definition (Node));
-
-         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
-            return "concurrent procedure call";
-         when Iir_Kind_Generate_Statement =>
-            return "generate statement";
-
-         when Iir_Kind_Simple_Simultaneous_Statement =>
-            return "simple simultaneous statement";
-
-         when Iir_Kind_Psl_Declaration =>
-            return Disp_Identifier (Node, "PSL declaration");
-
-         when Iir_Kind_Terminal_Declaration =>
-            return Disp_Identifier (Node, "terminal declaration");
-         when Iir_Kind_Free_Quantity_Declaration
-           | Iir_Kind_Across_Quantity_Declaration
-           | Iir_Kind_Through_Quantity_Declaration =>
-            return Disp_Identifier (Node, "quantity declaration");
-
-         when Iir_Kind_Attribute_Declaration =>
-            return Disp_Identifier (Node, "attribute");
-         when Iir_Kind_Attribute_Specification =>
-            return "attribute specification";
-         when Iir_Kind_Entity_Class =>
-            return "entity class";
-         when Iir_Kind_Attribute_Value =>
-            return "attribute value";
-         when Iir_Kind_Attribute_Name =>
-            return "attribute";
-         when Iir_Kind_Base_Attribute =>
-            return "'base attribute";
-         when Iir_Kind_Length_Array_Attribute =>
-            return "'length attribute";
-         when Iir_Kind_Range_Array_Attribute =>
-            return "'range attribute";
-         when Iir_Kind_Reverse_Range_Array_Attribute =>
-            return "'reverse_range attribute";
-         when Iir_Kind_Ascending_Type_Attribute
-           | Iir_Kind_Ascending_Array_Attribute =>
-            return "'ascending attribute";
-         when Iir_Kind_Left_Type_Attribute
-           | Iir_Kind_Left_Array_Attribute =>
-            return "'left attribute";
-         when Iir_Kind_Right_Type_Attribute
-           | Iir_Kind_Right_Array_Attribute =>
-            return "'right attribute";
-         when Iir_Kind_Low_Type_Attribute
-           | Iir_Kind_Low_Array_Attribute =>
-            return "'low attribute";
-         when Iir_Kind_Leftof_Attribute =>
-            return "'leftof attribute";
-         when Iir_Kind_Rightof_Attribute =>
-            return "'rightof attribute";
-         when Iir_Kind_Pred_Attribute =>
-            return "'pred attribute";
-         when Iir_Kind_Succ_Attribute =>
-            return "'succ attribute";
-         when Iir_Kind_Pos_Attribute =>
-            return "'pos attribute";
-         when Iir_Kind_Val_Attribute =>
-            return "'val attribute";
-         when Iir_Kind_Image_Attribute =>
-            return "'image attribute";
-         when Iir_Kind_Value_Attribute =>
-            return "'value attribute";
-         when Iir_Kind_High_Type_Attribute
-           | Iir_Kind_High_Array_Attribute =>
-            return "'high attribute";
-         when Iir_Kind_Transaction_Attribute =>
-            return "'transaction attribute";
-         when Iir_Kind_Stable_Attribute =>
-            return "'stable attribute";
-         when Iir_Kind_Quiet_Attribute =>
-            return "'quiet attribute";
-         when Iir_Kind_Delayed_Attribute =>
-            return "'delayed attribute";
-         when Iir_Kind_Driving_Attribute =>
-            return "'driving attribute";
-         when Iir_Kind_Driving_Value_Attribute =>
-            return "'driving_value attribute";
-         when Iir_Kind_Event_Attribute =>
-            return "'event attribute";
-         when Iir_Kind_Active_Attribute =>
-            return "'active attribute";
-         when Iir_Kind_Last_Event_Attribute =>
-            return "'last_event attribute";
-         when Iir_Kind_Last_Active_Attribute =>
-            return "'last_active attribute";
-         when Iir_Kind_Last_Value_Attribute =>
-            return "'last_value attribute";
-         when Iir_Kind_Behavior_Attribute =>
-            return "'behavior attribute";
-         when Iir_Kind_Structure_Attribute =>
-            return "'structure attribute";
-
-         when Iir_Kind_Path_Name_Attribute =>
-            return "'path_name attribute";
-         when Iir_Kind_Instance_Name_Attribute =>
-            return "'instance_name attribute";
-         when Iir_Kind_Simple_Name_Attribute =>
-            return "'simple_name attribute";
-
-         when Iir_Kind_For_Loop_Statement =>
-            return Disp_Label (Node, "for loop statement");
-         when Iir_Kind_While_Loop_Statement =>
-            return Disp_Label (Node, "loop statement");
-         when Iir_Kind_Process_Statement
-           | Iir_Kind_Sensitized_Process_Statement =>
-            return Disp_Label (Node, "process");
-         when Iir_Kind_Block_Statement =>
-            return Disp_Label (Node, "block statement");
-         when Iir_Kind_Block_Header =>
-            return "block header";
-         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
-            return Disp_Label
-              (Node, "concurrent conditional signal assignment");
-         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
-            return Disp_Label
-              (Node, "concurrent selected signal assignment");
-         when Iir_Kind_Concurrent_Assertion_Statement =>
-            return Disp_Label (Node, "concurrent assertion");
-         when Iir_Kind_Psl_Assert_Statement =>
-            return Disp_Label (Node, "PSL assertion");
-         when Iir_Kind_Psl_Cover_Statement =>
-            return Disp_Label (Node, "PSL cover");
-         when Iir_Kind_Psl_Default_Clock =>
-            return "PSL default clock";
-
-         when Iir_Kind_If_Statement =>
-            return Disp_Label (Node, "if statement");
-         when Iir_Kind_Elsif =>
-            return Disp_Label (Node, "else/elsif statement");
-         when Iir_Kind_Next_Statement =>
-            return Disp_Label (Node, "next statement");
-         when Iir_Kind_Exit_Statement =>
-            return Disp_Label (Node, "exit statement");
-         when Iir_Kind_Case_Statement =>
-            return Disp_Label (Node, "case statement");
-         when Iir_Kind_Return_Statement =>
-            return Disp_Label (Node, "return statement");
-         when Iir_Kind_Signal_Assignment_Statement =>
-            return Disp_Label (Node, "signal assignment statement");
-         when Iir_Kind_Variable_Assignment_Statement =>
-            return Disp_Label (Node, "variable assignment statement");
-         when Iir_Kind_Null_Statement =>
-            return Disp_Label (Node, "null statement");
-         when Iir_Kind_Wait_Statement =>
-            return Disp_Label (Node, "wait statement");
-         when Iir_Kind_Assertion_Statement =>
-            return Disp_Label (Node, "assertion statement");
-         when Iir_Kind_Report_Statement =>
-            return Disp_Label (Node, "report statement");
-
-         when Iir_Kind_Block_Configuration =>
-            return "block configuration";
-         when Iir_Kind_Binding_Indication =>
-            return "binding indication";
-
-         when Iir_Kind_Error =>
-            return "error";
-         when Iir_Kind_Unused =>
-            return "*unused*";
-      end case;
-   end Disp_Node;
-
-   -- Disp a node location.
-   -- Used for output of message.
-
-   function Get_Location_Str
-     (Name : Name_Id; Line, Col : Natural; Filename : Boolean)
-     return String
-   is
-      Line_Str : constant String := Natural'Image (Line);
-      Col_Str : constant String := Natural'Image (Col);
-   begin
-      if Filename then
-         return Name_Table.Image (Name)
-           & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last)
-           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
-      else
-         return Line_Str (Line_Str'First + 1 .. Line_Str'Last)
-           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
-      end if;
-   end Get_Location_Str;
-
-   function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True)
-     return string
-   is
-      Line, Col : Natural;
-      Name : Name_Id;
-   begin
-      if Loc = Location_Nil then
-         --  Avoid a crash.
-         return "??:??:??";
-      else
-         Location_To_Position (Loc, Name, Line, Col);
-         return Get_Location_Str (Name, Line, Col, Filename);
-      end if;
-   end Get_Location_Str;
-
-   function Disp_Location (Node: Iir) return String is
-   begin
-      return Get_Location_Str (Get_Location (Node));
-   end Disp_Location;
-
-   function Disp_Name (Kind : Iir_Kind) return String is
-   begin
-      case Kind is
-         when Iir_Kind_Constant_Declaration =>
-            return "constant declaration";
-         when Iir_Kind_Signal_Declaration =>
-            return "signal declaration";
-         when Iir_Kind_Variable_Declaration =>
-            return "variable declaration";
-         when Iir_Kind_File_Declaration =>
-            return "file declaration";
-         when others =>
-            return "???" & Iir_Kind'Image (Kind);
-      end case;
-   end Disp_Name;
-
-   function Image (N : Iir_Int64) return String
-   is
-      Res : constant String := Iir_Int64'Image (N);
-   begin
-      if Res (1) = ' ' then
-         return Res (2 .. Res'Last);
-      else
-         return Res;
-      end if;
-   end Image;
-
-   function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is
-   begin
-      case Get_Kind (Dtype) is
-         when Iir_Kind_Integer_Type_Definition =>
-            return Image (Pos);
-         when Iir_Kind_Enumeration_Type_Definition =>
-            return Name_Table.Image
-              (Get_Identifier (Get_Nth_Element
-                               (Get_Enumeration_Literal_List (Dtype),
-                                Natural (Pos))));
-         when others =>
-            Error_Kind ("disp_discrete", Dtype);
-      end case;
-   end Disp_Discrete;
-
-   function Disp_Subprg (Subprg : Iir) return String
-   is
-      use Ada.Strings.Unbounded;
-      Res : Unbounded_String;
-
-      procedure Append_Type (Def : Iir)
-      is
-         use Name_Table;
-         Decl : Iir := Get_Type_Declarator (Def);
-      begin
-         if Decl = Null_Iir then
-            Decl := Get_Type_Declarator (Get_Base_Type (Def));
-         end if;
-         Image (Get_Identifier (Decl));
-         Append (Res, Name_Buffer (1 .. Name_Length));
-      end Append_Type;
-
-   begin
-      case Get_Kind (Subprg) is
-         when Iir_Kind_Enumeration_Literal =>
-            Append (Res, "enumeration literal ");
-         when Iir_Kind_Implicit_Function_Declaration =>
-            Append (Res, "implicit function ");
-         when Iir_Kind_Implicit_Procedure_Declaration =>
-            Append (Res, "implicit procedure ");
-         when Iir_Kind_Function_Declaration =>
-            Append (Res, "function ");
-         when Iir_Kind_Procedure_Declaration =>
-            Append (Res, "procedure ");
-         when others =>
-            Error_Kind ("disp_subprg", Subprg);
-      end case;
-
-      declare
-         use Name_Table;
-
-         Id : constant Name_Id := Get_Identifier (Subprg);
-      begin
-         Image (Id);
-         case Id is
-            when Std_Names.Name_Id_Operators
-              | Std_Names.Name_Word_Operators
-              | Std_Names.Name_Xnor
-              | Std_Names.Name_Shift_Operators =>
-               Append (Res, """");
-               Append (Res, Name_Buffer (1 .. Name_Length));
-               Append (Res, """");
-            when others =>
-               Append (Res, Name_Buffer (1 .. Name_Length));
-         end case;
-      end;
-
-      Append (Res, " [");
-
-      case Get_Kind (Subprg) is
-         when Iir_Kind_Implicit_Function_Declaration
-           | Iir_Kind_Implicit_Procedure_Declaration
-           | Iir_Kind_Function_Declaration
-           | Iir_Kind_Procedure_Declaration =>
-            declare
-               El : Iir;
-            begin
-               El := Get_Interface_Declaration_Chain (Subprg);
-               while El /= Null_Iir loop
-                  Append_Type (Get_Type (El));
-                  El := Get_Chain (El);
-                  exit when El = Null_Iir;
-                  Append (Res, ", ");
-               end loop;
-            end;
-         when others =>
-            null;
-      end case;
-
-      case Get_Kind (Subprg) is
-         when Iir_Kind_Implicit_Function_Declaration
-           | Iir_Kind_Function_Declaration
-           | Iir_Kind_Enumeration_Literal =>
-            Append (Res, " return ");
-            Append_Type (Get_Return_Type (Subprg));
-         when others =>
-            null;
-      end case;
-
-      Append (Res, "]");
-
-      return To_String (Res);
-   end Disp_Subprg;
-
-   --  DEF must be any type definition.
-   --  Return the type name of DEF, handle anonymous subtypes.
-   function Disp_Type_Name (Def : Iir) return String
-   is
-      Decl : Iir;
-   begin
-      Decl := Get_Type_Declarator (Def);
-      if Decl /= Null_Iir then
-         return Image_Identifier (Decl);
-      end if;
-      Decl := Get_Type_Declarator (Get_Base_Type (Def));
-      if Decl /= Null_Iir then
-         return "a subtype of " & Image_Identifier (Decl);
-      else
-         return "an unknown type";
-      end if;
-   end Disp_Type_Name;
-
-   function Disp_Type_Of (Node : Iir) return String
-   is
-      A_Type : Iir;
-   begin
-      A_Type := Get_Type (Node);
-      if A_Type = Null_Iir then
-         return "unknown";
-      elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then
-         declare
-            use Ada.Strings.Unbounded;
-            Res : Unbounded_String;
-            List : Iir_List;
-            El : Iir;
-            Nbr : Natural;
-         begin
-            List := Get_Overload_List (A_Type);
-            Nbr := Get_Nbr_Elements (List);
-            if Nbr = 0 then
-               return "unknown";
-            elsif Nbr = 1 then
-               return Disp_Type_Name (Get_First_Element (List));
-            else
-               Append (Res, "one of ");
-               for I in 0 .. Nbr - 1 loop
-                  El := Get_Nth_Element (List, I);
-                  Append (Res, Disp_Type_Name (El));
-                  if I < Nbr - 2 then
-                     Append (Res, ", ");
-                  elsif I = Nbr - 2 then
-                     Append (Res, " or ");
-                  end if;
-               end loop;
-               return To_String (Res);
-            end if;
-         end;
-      else
-         return Disp_Type_Name (A_Type);
-      end if;
-   end Disp_Type_Of;
-
-   procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir)
-   is
-      L : Location_Type;
-   begin
-      if Loc = Null_Iir then
-         L := Get_Location (Caller);
-      else
-         L := Get_Location (Loc);
-      end if;
-      Error_Msg_Sem
-        ("pure " & Disp_Node (Caller) & " cannot call (impure) "
-         & Disp_Node (Callee), L);
-      Error_Msg_Sem
-        ("(" & Disp_Node (Callee) & " is defined here)", Callee);
-   end Error_Pure;
-
-   procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir)
-   is
-   begin
-      Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type "
-                     & Disp_Node (A_Type), Loc);
-      if Loc /= Expr then
-         Error_Msg_Sem ("(location of " & Disp_Node (Expr) & ")", Expr);
-      end if;
-   end Error_Not_Match;
-
-   function Get_Mode_Name (Mode : Iir_Mode) return String is
-   begin
-      case Mode is
-         when Iir_Unknown_Mode =>
-            raise Internal_Error;
-         when Iir_Linkage_Mode =>
-            return "linkage";
-         when Iir_Buffer_Mode =>
-            return "buffer";
-         when Iir_Out_Mode =>
-            return "out";
-         when Iir_Inout_Mode =>
-            return "inout";
-         when Iir_In_Mode =>
-            return "in";
-      end case;
-   end Get_Mode_Name;
-
-end Errorout;