1 files changed, 69 insertions, 15 deletions

diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index c1d219011..16f26df22 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -17,6 +17,7 @@
 --  02111-1307, USA.
 with Types; use Types;
 with Iirs; use Iirs;
+with Tokens;
 
 package Errorout is
    Option_Error: exception;
@@ -110,6 +111,28 @@ package Errorout is
    --  Get enable status of a warning.
    function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
 
+   type Earg_Type is private;
+   type Earg_Arr is array (Natural range <>) of Earg_Type;
+
+   --  An empty array (for no arguments).
+   No_Eargs : constant Earg_Arr;
+
+   --  Report display:
+   --  %%: %
+   --  %i: identifier
+   --  %c: character
+   --  %t: token
+   --  %l: location
+   function "+" (V : Iir) return Earg_Type;
+   function "+" (V : Location_Type) return Earg_Type;
+   function "+" (V : Name_Id) return Earg_Type;
+   function "+" (V : Tokens.Token_Type) return Earg_Type;
+   function "+" (V : Character) return Earg_Type;
+
+   --  Convert location.
+   function "+" (L : Iir) return Location_Type;
+
+   --  Pass that detected the error.
    type Report_Origin is
      (Option, Library, Scan, Parse, Semantic, Elaboration);
 
@@ -119,7 +142,9 @@ package Errorout is
    procedure Report_Msg (Id : Msgid_Type;
                          Origin : Report_Origin;
                          Loc : Location_Type;
-                         Msg : String);
+                         Msg : String;
+                         Args : Earg_Arr := No_Eargs;
+                         Cont : Boolean := False);
 
    --  Disp an error, prepended with program name, and raise option_error.
    --  This is used for errors before initialisation, such as bad option or
@@ -130,39 +155,44 @@ package Errorout is
    --  Same as Error_Msg_Option but do not raise Option_Error.
    procedure Error_Msg_Option_NR (Msg: String);
 
-   -- Disp a warning.
-   procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings);
-   procedure Warning_Msg_Sem
-     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings);
-
    -- Disp a message during scan.
    -- The current location is automatically displayed before the message.
    procedure Error_Msg_Scan (Msg: String);
-   procedure Error_Msg_Scan (Msg: String; Loc : Location_Type);
-   procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings);
+   procedure Error_Msg_Scan (Msg: String; Arg1 : Earg_Type);
+   procedure Error_Msg_Scan (Loc : Location_Type; Msg: String);
+   procedure Warning_Msg_Scan (Id : Msgid_Warnings; Msg: String);
+   procedure Warning_Msg_Scan (Id : Msgid_Warnings;
+                               Msg: String;
+                               Arg1 : Earg_Type;
+                               Cont : Boolean := False);
 
    -- Disp a message during parse
    -- The location of the current token is automatically displayed before
    -- the message.
-   procedure Error_Msg_Parse (Msg: String);
-   procedure Error_Msg_Parse (Msg: String; Loc : Iir);
-   procedure Error_Msg_Parse (Msg: String; Loc : Location_Type);
+   procedure Error_Msg_Parse_1 (Msg: String);
+   procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type);
+   procedure Error_Msg_Parse
+     (Msg: String; Args : Earg_Arr := No_Eargs; Cont : Boolean := False);
+   procedure Error_Msg_Parse (Loc : Location_Type; Msg: String);
 
    -- Disp a message during semantic analysis.
-   -- an_iir is used for location and current token.
+   procedure Warning_Msg_Sem
+     (Id : Msgid_Warnings; Loc : Location_Type; Msg: String);
+
    procedure Error_Msg_Sem (Msg: String; Loc: Iir);
    procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node);
    procedure Error_Msg_Sem (Msg: String; Loc: Location_Type);
 
    --  Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
-   procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir);
+   procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String);
 
    -- Disp a message during elaboration (or configuration).
    procedure Error_Msg_Elab (Msg: String);
-   procedure Error_Msg_Elab (Msg: String; Loc: Iir);
+   procedure Error_Msg_Elab (Loc: Iir; Msg: String);
 
    --  Disp a warning durig elaboration (or configuration).
-   procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings);
+   procedure Warning_Msg_Elab
+     (Id : Msgid_Warnings; Loc : Iir; Msg: String; Cont : Boolean := False);
 
    -- Disp a bug message.
    procedure Error_Internal (Expr: Iir; Msg: String := "");
@@ -207,4 +237,28 @@ package Errorout is
 
    --  Disp interface mode MODE.
    function Get_Mode_Name (Mode : Iir_Mode) return String;
+
+private
+   type Earg_Kind is
+     (Earg_None,
+      Earg_Iir, Earg_Location, Earg_Id, Earg_Char, Earg_Token);
+
+   type Earg_Type (Kind : Earg_Kind := Earg_None) is record
+      case Kind is
+         when Earg_None =>
+            null;
+         when Earg_Iir =>
+            Val_Iir : Iir;
+         when Earg_Location =>
+            Val_Loc : Location_Type;
+         when Earg_Id =>
+            Val_Id : Name_Id;
+         when Earg_Char =>
+            Val_Char : Character;
+         when Earg_Token =>
+            Val_Tok : Tokens.Token_Type;
+      end case;
+   end record;
+
+   No_Eargs : constant Earg_Arr := (1 .. 0 => (Kind => Earg_None));
 end Errorout;