Rewrite scan error messages: use formatting.

19 files changed, 464 insertions, 247 deletions

diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index f9b814404..04f2ba4ee 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -240,7 +240,7 @@ package body Ghdlprint is
             Ref := Find (Loc);
             if Ref = Bad_Xref then
                Disp_Text;
-               Warning_Msg_Sem ("cannot find xref", Loc, Warnid_Missing_Xref);
+               Warning_Msg_Sem (Warnid_Missing_Xref, Loc, "cannot find xref");
                Missing_Xref := True;
                return;
             end if;
diff --git a/src/libraries.adb b/src/libraries.adb
index 71ae71e46..0a91dbc8c 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -1007,12 +1007,14 @@ package body Libraries is
                   --  Warns only if we are not re-analyzing the file.
                   if Is_Warning_Enabled (Warnid_Library) then
                      Warning_Msg_Sem
-                       ("redefinition of a library unit in "
-                        & "same design file:", Unit, Warnid_Library);
+                       (Warnid_Library, +Unit,
+                        "redefinition of a library unit in "
+                          & "same design file:");
                      Warning_Msg_Sem
-                       (Disp_Node (Library_Unit) & " defined at "
-                        & Disp_Location (Library_Unit) & " is now "
-                        & Disp_Node (New_Library_Unit), Unit, Warnid_Library);
+                       (Warnid_Library, +Unit,
+                        Disp_Node (Library_Unit) & " defined at "
+                          & Disp_Location (Library_Unit) & " is now "
+                          & Disp_Node (New_Library_Unit));
                   end if;
                else
                   --  Free the stub.
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index 671514e46..5e9bafc99 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -197,8 +197,9 @@ package body Configuration is
                if not Flags.Flag_Elaborate_With_Outdated then
                   --  LIB_UNIT requires a body.
                   if Bod = Null_Iir then
-                     Error_Msg_Elab ("body of " & Disp_Node (Lib_Unit)
-                                     & " was never analyzed", Lib_Unit);
+                     Error_Msg_Elab
+                       (Lib_Unit, "body of " & Disp_Node (Lib_Unit)
+                          & " was never analyzed");
                   elsif Get_Date (Bod) < Get_Date (Unit) then
                      Error_Msg_Elab (Disp_Node (Bod) & " is outdated");
                      Bod := Null_Iir;
@@ -321,8 +322,8 @@ package body Configuration is
             else
                Arch := Get_Latest_Architecture (Entity_Lib);
                if Arch = Null_Iir then
-                  Error_Msg_Elab ("no architecture in library for "
-                                  & Disp_Node (Entity_Lib), Aspect);
+                  Error_Msg_Elab (Aspect, "no architecture in library for "
+                                  & Disp_Node (Entity_Lib));
                   return;
                end if;
                Arch := Get_Design_Unit (Arch);
@@ -372,7 +373,7 @@ package body Configuration is
             if Get_Default_Value (Port) = Null_Iir then
                if Loc /= Null_Iir then
                   Error_Msg_Elab
-                    ("IN " & Disp_Node (Port) & " must be connected", Loc);
+                    (Loc, "IN " & Disp_Node (Port) & " must be connected");
                end if;
                return True;
             end if;
@@ -389,8 +390,8 @@ package body Configuration is
                           /= Fully_Constrained)
             then
                if Loc /= Null_Iir then
-                  Error_Msg_Elab ("unconstrained " & Disp_Node (Port)
-                                  & " must be connected", Loc);
+                  Error_Msg_Elab (Loc, "unconstrained " & Disp_Node (Port)
+                                  & " must be connected");
                end if;
                return True;
             end if;
@@ -429,11 +430,12 @@ package body Configuration is
               and then not Get_Artificial_Flag (Assoc)
             then
                Warning_Msg_Elab
-                 (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
-                  & " is not bound", Assoc, Warnid_Binding);
+                 (Warnid_Binding, Assoc,
+                  Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
+                    & " is not bound", Cont => True);
                Warning_Msg_Elab
-                 ("(in " & Disp_Node (Current_Configuration) & ")",
-                  Current_Configuration, Warnid_Binding);
+                 (Warnid_Binding, Current_Configuration,
+                  "(in " & Disp_Node (Current_Configuration) & ")");
             end if;
          end if;
          Assoc := Get_Chain (Assoc);
@@ -522,10 +524,11 @@ package body Configuration is
          if Is_Warning_Enabled (Warnid_Binding) then
             Inst := Get_First_Element (Get_Instantiation_List (Conf));
             Warning_Msg_Elab
-              (Disp_Node (Inst) & " is not bound", Conf, Warnid_Binding);
+              (Warnid_Binding, Conf,
+               Disp_Node (Inst) & " is not bound", Cont => True);
             Warning_Msg_Elab
-              ("(in " & Disp_Node (Current_Configuration) & ")",
-               Current_Configuration, Warnid_Binding);
+              (Warnid_Binding, Current_Configuration,
+               "(in " & Disp_Node (Current_Configuration) & ")");
          end if;
          return;
       end if;
@@ -707,7 +710,7 @@ package body Configuration is
               (Disp_Node (Entity) & " cannot be at the top of a design");
             Has_Error := True;
          end if;
-         Error_Msg_Elab (Msg, Loc);
+         Error_Msg_Elab (Loc, Msg);
       end Error;
 
       El : Iir;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 680160098..afb7be49d 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -75,6 +75,42 @@ package body Errorout is
       return Res;
    end Warning_Image;
 
+   function "+" (V : Iir) return Earg_Type is
+   begin
+      return (Kind => Earg_Iir, Val_Iir => V);
+   end "+";
+
+   function "+" (V : Location_Type) return Earg_Type is
+   begin
+      return (Kind => Earg_Location, Val_Loc => V);
+   end "+";
+
+   function "+" (V : Name_Id) return Earg_Type is
+   begin
+      return (Kind => Earg_Id, Val_Id => V);
+   end "+";
+
+   function "+" (V : Tokens.Token_Type) return Earg_Type is
+   begin
+      return (Kind => Earg_Token, Val_Tok => V);
+   end "+";
+
+   function "+" (V : Character) return Earg_Type is
+   begin
+      return (Kind => Earg_Char, Val_Char => V);
+   end "+";
+
+   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;
+
+   function "+" (L : Iir) return Location_Type renames Get_Location_Safe;
+
    procedure Put (Str : String)
    is
       use Ada.Text_IO;
@@ -146,8 +182,11 @@ package body 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)
    is
+      pragma Unreferenced (Cont);
       procedure Location_To_Position (Location : Location_Type;
                                       File : out Source_File_Entry;
                                       Line : out Natural;
@@ -234,7 +273,127 @@ package body Errorout is
       end case;
 
       Put (' ');
-      Put_Line (Msg);
+
+      --  Display message.
+      declare
+         First, N : Positive;
+         Argn : Integer;
+      begin
+         N := Msg'First;
+         First := N;
+         Argn := Args'First;
+         while N <= Msg'Last loop
+            if Msg (N) = '%' then
+               Put (Msg (First .. N - 1));
+               First := N + 2;
+               pragma Assert (N < Msg'Last);
+               N := N + 1;
+               case Msg (N) is
+                  when '%' =>
+                     Put ('%');
+                     Argn := Argn - 1;
+                  when 'i' =>
+                     --  Identifier.
+                     declare
+                        Arg : Earg_Type renames Args (Argn);
+                        Id : Name_Id;
+                     begin
+                        Put ('"');
+                        case Arg.Kind is
+                           when Earg_Iir =>
+                              Id := Get_Identifier (Arg.Val_Iir);
+                           when Earg_Id =>
+                              Id := Arg.Val_Id;
+                           when others =>
+                              --  Invalid conversion to identifier.
+                              raise Internal_Error;
+                        end case;
+                        Put (Name_Table.Image (Id));
+                        Put ('"');
+                     end;
+                  when 'c' =>
+                     --  Character
+                     declare
+                        Arg : Earg_Type renames Args (Argn);
+                     begin
+                        Put (''');
+                        case Arg.Kind is
+                           when Earg_Char =>
+                              Put (Arg.Val_Char);
+                           when others =>
+                              --  Invalid conversion to character.
+                              raise Internal_Error;
+                        end case;
+                        Put (''');
+                     end;
+                  when 't' =>
+                     --  A token
+                     declare
+                        use Tokens;
+                        Arg : Earg_Type renames Args (Argn);
+                        Tok : Token_Type;
+                     begin
+                        case Arg.Kind is
+                           when Earg_Token =>
+                              Tok := Arg.Val_Tok;
+                           when others =>
+                              --  Invalid conversion to character.
+                              raise Internal_Error;
+                        end case;
+                        if Tok = Tok_Identifier then
+                           Put ("an identifier");
+                        else
+                           Put (''');
+                           Put (Image (Tok));
+                           Put (''');
+                        end if;
+                     end;
+                  when 'l' =>
+                     --  Location
+                     declare
+                        Arg : Earg_Type renames Args (Argn);
+                        Arg_Loc : Location_Type;
+                        Arg_File : Source_File_Entry;
+                        Arg_Line : Natural;
+                        Arg_Col : Natural;
+                     begin
+                        pragma Assert (not Progname);
+                        case Arg.Kind is
+                           when Earg_Location =>
+                              Arg_Loc := Arg.Val_Loc;
+                           when Earg_Iir =>
+                              Arg_Loc := Get_Location (Arg.Val_Iir);
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                        Location_To_Position
+                          (Arg_Loc, Arg_File, Arg_Line, Arg_Col);
+
+                        --  Do not print the filename if in the same file as
+                        --  the error location.
+                        if Arg_File = File then
+                           Put ("line ");
+                        else
+                           Put (Name_Table.Image (Get_File_Name (Arg_File)));
+                           Put (':');
+                        end if;
+                        Disp_Natural (Arg_Line);
+                        Put (':');
+                        Disp_Natural (Arg_Col);
+                     end;
+                  when others =>
+                     --  Unknown format.
+                     raise Internal_Error;
+               end case;
+               Argn := Argn + 1;
+            end if;
+            N := N + 1;
+         end loop;
+         Put_Line (Msg (First .. N - 1));
+
+         --  Are all arguments displayed ?
+         pragma Assert (Argn > Args'Last);
+      end;
 
       if Flag_Show_Caret
         and then (File /= No_Source_File_Entry and Line /= 0)
@@ -269,17 +428,8 @@ package body Errorout is
       raise Option_Error;
    end Error_Msg_Option;
 
-   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 Warning_Msg_Sem
-     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
+     (Id : Msgid_Warnings; Loc : Location_Type; Msg: String) is
    begin
       if Flags.Flag_Only_Elab_Warnings then
          return;
@@ -287,20 +437,10 @@ package body Errorout is
       Report_Msg (Id, Semantic, Loc, Msg);
    end Warning_Msg_Sem;
 
-   procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
-   begin
-      Warning_Msg_Sem (Msg, Get_Location_Safe (Loc), Id);
-   end Warning_Msg_Sem;
-
    procedure Warning_Msg_Elab
-     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
-   begin
-      Report_Msg (Id, Elaboration, Loc, Msg);
-   end Warning_Msg_Elab;
-
-   procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
+     (Id : Msgid_Warnings; Loc : Iir; Msg: String; Cont : Boolean := False) is
    begin
-      Warning_Msg_Elab (Msg, Get_Location_Safe (Loc), Id);
+      Report_Msg (Id, Elaboration, Get_Location_Safe (Loc), Msg, Cont => Cont);
    end Warning_Msg_Elab;
 
    -- Disp a message during scan.
@@ -309,29 +449,47 @@ package body Errorout is
       Report_Msg (Msgid_Error, Scan, No_Location, Msg);
    end Error_Msg_Scan;
 
-   procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
+   procedure Error_Msg_Scan (Loc : Location_Type; Msg: String) is
    begin
       Report_Msg (Msgid_Error, Scan, Loc, Msg);
    end Error_Msg_Scan;
 
+   procedure Error_Msg_Scan (Msg: String; Arg1 : Earg_Type) is
+   begin
+      Report_Msg (Msgid_Error, Scan, No_Location, Msg, (1 => Arg1));
+   end Error_Msg_Scan;
+
    -- Disp a message during scan.
-   procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings) is
+   procedure Warning_Msg_Scan (Id : Msgid_Warnings; Msg: String) is
    begin
       Report_Msg (Id, Scan, No_Location, Msg);
    end Warning_Msg_Scan;
 
-   -- Disp a message during scan.
-   procedure Error_Msg_Parse (Msg: String) is
+   procedure Warning_Msg_Scan (Id : Msgid_Warnings;
+                               Msg: String;
+                               Arg1 : Earg_Type;
+                               Cont : Boolean := False) is
    begin
-      Report_Msg (Msgid_Error, Parse, No_Location, Msg);
+      Report_Msg (Id, Scan, No_Location, Msg, (1 => Arg1), Cont);
+   end Warning_Msg_Scan;
+
+   procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type) is
+   begin
+      Report_Msg (Msgid_Error, Parse, No_Location, Msg, (1 => Arg1));
    end Error_Msg_Parse;
 
-   procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
+   procedure Error_Msg_Parse
+     (Msg: String; Args : Earg_Arr := No_Eargs; Cont : Boolean := False) is
    begin
-      Report_Msg (Msgid_Error, Parse, Get_Location_Safe (Loc), Msg);
+      Report_Msg (Msgid_Error, Parse, No_Location, Msg, Args, Cont);
    end Error_Msg_Parse;
 
-   procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
+   procedure Error_Msg_Parse_1 (Msg: String) is
+   begin
+      Report_Msg (Msgid_Error, Parse, No_Location, Msg);
+   end Error_Msg_Parse_1;
+
+   procedure Error_Msg_Parse (Loc : Location_Type; Msg: String) is
    begin
       Report_Msg (Msgid_Error, Parse, Loc, Msg);
    end Error_Msg_Parse;
@@ -375,7 +533,7 @@ package body Errorout is
       Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Relaxed;
 
-   procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir) is
+   procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String) is
    begin
       Error_Msg_Relaxed (Semantic, Msg, Loc);
    end Error_Msg_Sem_Relaxed;
@@ -386,7 +544,7 @@ package body Errorout is
       Report_Msg (Msgid_Error, Elaboration, No_Location, Msg);
    end Error_Msg_Elab;
 
-   procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
+   procedure Error_Msg_Elab (Loc : Iir; Msg: String) is
    begin
       Report_Msg (Msgid_Error, Elaboration, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Elab;
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;
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index e0b52fd9f..952f05cd0 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -560,8 +560,8 @@ package body Evaluation is
    exception
       when Constraint_Error =>
          --  Can happen for absolute.
-         Warning_Msg_Sem ("arithmetic overflow in static expression",
-                          Orig, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+                          "arithmetic overflow in static expression");
          return Build_Overflow (Orig);
    end Eval_Monadic_Operator;
 
@@ -580,8 +580,8 @@ package body Evaluation is
    begin
       Len := Get_String_Length (Left);
       if Len /= Get_String_Length (Right) then
-         Warning_Msg_Sem ("length of left and right operands mismatch",
-                          Expr, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                          "length of left and right operands mismatch");
          return Build_Overflow (Expr);
       else
          Id := Create_String8;
@@ -680,7 +680,7 @@ package body Evaluation is
    is
    begin
       if Get_Value (Val) = 0 then
-         Warning_Msg_Sem ("division by 0", Expr, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Expr, "division by 0");
          return False;
       else
          return True;
@@ -1127,8 +1127,8 @@ package body Evaluation is
               (Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig);
          when Iir_Predefined_Floating_Div =>
             if Get_Fp_Value (Right) = 0.0 then
-               Warning_Msg_Sem ("right operand of division is 0",
-                                Orig, Warnid_Runtime_Error);
+               Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+                                "right operand of division is 0");
                return Build_Overflow (Orig);
             else
                return Build_Floating
@@ -1455,8 +1455,8 @@ package body Evaluation is
       end case;
    exception
       when Constraint_Error =>
-         Warning_Msg_Sem ("arithmetic overflow in static expression",
-                          Orig, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+                          "arithmetic overflow in static expression");
          return Build_Overflow (Orig);
    end Eval_Dyadic_Operator;
 
@@ -1649,8 +1649,9 @@ package body Evaluation is
       if Res /= Null_Iir then
          return Build_Constant (Res, Expr);
       else
-         Warning_Msg_Sem ("value """ & Value & """ not in enumeration "
-                            & Disp_Node (Enum), Expr, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                          "value """ & Value & """ not in enumeration "
+                            & Disp_Node (Enum));
          return Build_Overflow (Expr);
       end if;
    end Build_Enumeration_Value;
@@ -1723,9 +1724,9 @@ package body Evaluation is
          Unit := Get_Chain (Unit);
       end loop;
       if Unit = Null_Iir then
-         Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last)
-                            & """ not in physical type",
-                          Expr, Warnid_Runtime_Error);
+         Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                          "Unit """ & UnitName (Sep + 1 .. UnitName'Last)
+                            & """ not in physical type");
          return Build_Overflow (Expr);
       end if;
 
@@ -1808,8 +1809,8 @@ package body Evaluation is
                             (Get_Enumeration_Literal_List
                                (Get_Base_Type (Get_Type (Expr))))))
             then
-               Warning_Msg_Sem ("static constant violates bounds",
-                                Expr, Warnid_Runtime_Error);
+               Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                                "static constant violates bounds");
                return Build_Overflow (Origin);
             else
                return Build_Enumeration (Iir_Index32 (P), Origin);
@@ -1867,8 +1868,8 @@ package body Evaluation is
       if Get_Constraint_State (Conv_Type) = Fully_Constrained then
          Set_Type (Res, Conv_Type);
          if not Eval_Is_In_Bound (Val, Conv_Type) then
-            Warning_Msg_Sem ("non matching length in type conversion",
-                             Conv, Warnid_Runtime_Error);
+            Warning_Msg_Sem (Warnid_Runtime_Error, +Conv,
+                             "non matching length in type conversion");
             return Build_Overflow (Conv);
          end if;
          return Res;
@@ -1937,8 +1938,8 @@ package body Evaluation is
       end if;
       if not Eval_Is_In_Bound (Res, Get_Type (Expr)) then
          if Get_Kind (Res) /= Iir_Kind_Overflow_Literal then
-            Warning_Msg_Sem ("result of conversion out of bounds",
-                             Expr, Warnid_Runtime_Error);
+            Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                             "result of conversion out of bounds");
             Res := Build_Overflow (Res);
          end if;
       end if;
@@ -2124,8 +2125,8 @@ package body Evaluation is
                  and then
                  not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type))
                then
-                  Warning_Msg_Sem ("static argument out of the type range",
-                                   Expr, Warnid_Runtime_Error);
+                  Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                                   "static argument out of the type range");
                   return Build_Overflow (Expr);
                end if;
                if Get_Kind (Get_Base_Type (Get_Type (Expr)))
@@ -2173,8 +2174,8 @@ package body Evaluation is
                Set_Parameter (Expr, Param);
                if Get_Kind (Param) /= Iir_Kind_String_Literal8 then
                   --  FIXME: Isn't it an implementation restriction.
-                  Warning_Msg_Sem ("'value argument not a string",
-                                   Expr, Warnid_Runtime_Error);
+                  Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                                   "'value argument not a string");
                   return Build_Overflow (Expr);
                else
                   return Eval_Value_Attribute
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index fb92efaf7..5f5af94b6 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -191,7 +191,7 @@ package body Ieee.Vital_Timing is
 
    procedure Warning_Vital (Msg : String; Loc : Iir) is
    begin
-      Warning_Msg_Sem (Msg, Loc, Warnid_Vital_Generic);
+      Warning_Msg_Sem (Warnid_Vital_Generic, +Loc, Msg);
    end Warning_Vital;
 
    --  Check DECL is the VITAL level 0 attribute specification.
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 6991b8c7b..92e0f5851 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -25,7 +25,6 @@ with Flags; use Flags;
 with Parse_Psl;
 with Name_Table;
 with Str_Table;
-with Files_Map; use Files_Map;
 with Xrefs;
 
 --  Recursive descendant parser.
@@ -87,7 +86,7 @@ package body Parse is
    procedure Unexpected (Where: String) is
    begin
       Error_Msg_Parse
-        ("unexpected token '" & Image (Current_Token) & "' in a " & Where);
+        ("unexpected token %t in a " & Where, +Current_Token);
    end Unexpected;
 
 --   procedure Unexpected_Eof is
@@ -102,16 +101,14 @@ package body Parse is
    begin
       if Current_Token /= Token then
          if Msg'Length > 0 then
-            Error_Msg_Parse (Msg);
-            Error_Msg_Parse ("(found: " & Image (Current_Token) & ")");
+            Error_Msg_Parse (Msg, Args => No_Eargs, Cont => True);
+            Error_Msg_Parse ("(found: %t)", +Current_Token);
          elsif Current_Token = Tok_Identifier then
             Error_Msg_Parse
-              (''' & Image(Token) & "' is expected instead of '"
-                 & Name_Table.Image (Current_Identifier) & ''');
+              ("%t is expected instead of %i", (+Token, +Current_Identifier));
          else
             Error_Msg_Parse
-              (''' & Image(Token) & "' is expected instead of '"
-               & Image (Current_Token) & ''');
+              ("%t is expected instead of %t", (+Token, + Current_Token));
          end if;
          raise Expect_Error;
       end if;
@@ -142,8 +139,7 @@ package body Parse is
            ("end label for an unlabeled declaration or statement");
       else
          if Current_Identifier /= Name then
-            Error_Msg_Parse
-              ("mispelling, """ & Name_Table.Image (Name) & """ expected");
+            Error_Msg_Parse ("mispelling, %i expected", +Name);
          else
             Set_End_Has_Identifier (Decl, True);
             Xrefs.Xref_End (Get_Token_Location, Decl);
@@ -168,8 +164,7 @@ package body Parse is
       else
          Scan;
          if Current_Token /= Tok then
-            Error_Msg_Parse
-              ("""end"" must be followed by """ & Image (Tok) & """");
+            Error_Msg_Parse ("""end"" must be followed by %t", +Tok);
          else
             Set_End_Has_Reserved_Id (Decl, True);
             Scan;
@@ -434,15 +429,15 @@ package body Parse is
 
       procedure Bad_Operator_Symbol is
       begin
-         Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len)
-                          & """ is not an operator symbol", Loc);
+         Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len)
+                          & """ is not an operator symbol");
       end Bad_Operator_Symbol;
 
       procedure Check_Vhdl93 is
       begin
          if Flags.Vhdl_Std = Vhdl_87 then
-            Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len)
-                             & """ is not a vhdl87 operator symbol", Loc);
+            Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len)
+                             & """ is not a vhdl87 operator symbol");
          end if;
       end Check_Vhdl93;
 
@@ -1015,7 +1010,7 @@ package body Parse is
             Scan;
          when others =>
             Error_Msg_Parse
-              ("constant, signal or variable expected after <<");
+              ("constant, signal or variable expected after '<<'");
             Kind := Iir_Kind_External_Signal_Name;
       end case;
 
@@ -1099,7 +1094,7 @@ package body Parse is
            | Iir_Kind_Selected_Name =>
             null;
          when others =>
-            Error_Msg_Parse ("type mark must be a name of a type", Mark);
+            Error_Msg_Parse (+Mark, "type mark must be a name of a type");
       end case;
    end Check_Type_Mark;
 
@@ -1505,10 +1500,10 @@ package body Parse is
             when Tok_Right_Paren =>
                if Res = Null_Iir then
                   Error_Msg_Parse
-                    ("empty interface list not allowed", Prev_Loc);
+                    (Prev_Loc, "empty interface list not allowed");
                else
                   Error_Msg_Parse
-                    ("extra ';' at end of interface list", Prev_Loc);
+                    (Prev_Loc, "extra ';' at end of interface list");
                end if;
                exit;
             when others =>
@@ -1578,7 +1573,7 @@ package body Parse is
       El := Res;
       while El /= Null_Iir loop
          if Get_Kind (El) /= Iir_Kind_Interface_Signal_Declaration then
-            Error_Msg_Parse ("port must be a signal", El);
+            Error_Msg_Parse (+El, "port must be a signal");
          end if;
          El := Get_Chain (El);
       end loop;
@@ -2284,8 +2279,8 @@ package body Parse is
                Error_Msg_Parse ("protected type not allowed in vhdl87/93");
                Decl := Parse_Protected_Type_Definition (Ident, Loc);
             else
-               Error_Msg_Parse ("type '" & Name_Table.Image (Ident) &
-                                "' cannot be defined from another type");
+               Error_Msg_Parse ("type %i cannot be defined from another type",
+                                (1 => +Ident), Cont => True);
                Error_Msg_Parse ("(you should declare a subtype)");
                Decl := Create_Iir (Iir_Kind_Type_Declaration);
                Eat_Tokens_Until_Semi_Colon;
@@ -2376,7 +2371,7 @@ package body Parse is
                if Get_Kind (Ind) = Iir_Kind_Simple_Name then
                   Id := Get_Identifier (Ind);
                else
-                  Error_Msg_Parse ("element name expected", Ind);
+                  Error_Msg_Parse (+Ind, "element name expected");
                   Id := Null_Identifier;
                end if;
                Free_Iir (Ind);
@@ -3411,8 +3406,7 @@ package body Parse is
            | Tok_File =>
             null;
          when others =>
-            Error_Msg_Parse
-              (''' & Tokens.Image (Current_Token) & "' is not a entity class");
+            Error_Msg_Parse ("%t is not a entity class", +Current_Token);
       end case;
       Res := Current_Token;
       Scan;
@@ -3770,8 +3764,8 @@ package body Parse is
                then
                   case Get_Kind (Parent) is
                      when Iir_Kind_Package_Declaration =>
-                        Error_Msg_Parse ("protected type body not allowed "
-                                         & "in package declaration", Decl);
+                        Error_Msg_Parse (+Decl, "protected type body not "
+                                           & "allowed in package declaration");
                      when others =>
                         null;
                   end case;
@@ -3939,7 +3933,7 @@ package body Parse is
       Scan;
       if Current_Token = Tok_Entity then
          if Flags.Vhdl_Std = Vhdl_87 then
-            Error_Msg_Parse ("""entity"" keyword not allowed here by vhdl 87");
+            Error_Msg_Parse ("'entity' keyword not allowed here by vhdl 87");
          end if;
          Set_End_Has_Reserved_Id (Res, True);
          Scan;
@@ -4072,8 +4066,8 @@ package body Parse is
                   --  Parenthesis around aggregate is useless and change the
                   --  context for array aggregate.
                   Warning_Msg_Sem
-                    ("suspicious parenthesis around aggregate",
-                     Expr, Warnid_Parenthesis);
+                    (Warnid_Parenthesis, +Expr,
+                     "suspicious parenthesis around aggregate");
                elsif not Flag_Parse_Parenthesis then
                   return Expr;
                end if;
@@ -4088,8 +4082,8 @@ package body Parse is
                --  Surely a missing parenthesis.
                --  FIXME: in case of multiple missing parenthesises, several
                --    messages will be displayed
-               Error_Msg_Parse ("missing ')' for opening parenthesis at "
-                                & Image (Loc, Filename => False));
+               Error_Msg_Parse
+                 ("missing ')' for opening parenthesis at %l", +Loc);
                return Expr;
             when others =>
                --  Surely a parse error...
@@ -4251,7 +4245,7 @@ package body Parse is
          if Is_Signed then
             if Old_Len = 0 then
                Error_Msg_Parse
-                 ("cannot expand an empty signed bit string", Lit);
+                 (+Lit, "cannot expand an empty signed bit string");
                C := Character'Pos ('0');
             else
                C := Element_String8 (Id, 1);
@@ -4297,7 +4291,7 @@ package body Parse is
          for I in 1 .. Old_Len - Nlen loop
             if Element_String8 (Id, I) /= C then
                Error_Msg_Parse
-                 ("truncation of bit string changes the value", Lit);
+                 (+Lit, "truncation of bit string changes the value");
                --  Avoid error storm.
                exit;
             end if;
@@ -4410,7 +4404,7 @@ package body Parse is
            | Tok_Double_Less =>
             Res := Parse_Name (Allow_Indexes => True);
             if Get_Kind (Res) = Iir_Kind_Signature then
-               Error_Msg_Parse ("signature not allowed in expression", Res);
+               Error_Msg_Parse (+Res, "signature not allowed in expression");
                return Get_Signature_Prefix (Res);
             else
                return Res;
@@ -4458,8 +4452,8 @@ package body Parse is
                Resize_Bit_String (Res, Nat32 (Int));
             else
                Error_Msg_Parse
-                 ("space is required between number and unit name",
-                  Get_Token_Location);
+                 (Get_Token_Location,
+                  "space is required between number and unit name");
                Res := Parse_Integer_Literal (Int);
             end if;
             Set_Location (Res, Loc);
@@ -4825,8 +4819,10 @@ package body Parse is
             --  operator...
             --  TODO: avoid repetition of this message ?
             if Op_Token = Tok_Nand or Op_Token = Tok_Nor then
-               Error_Msg_Parse ("sequence of 'nor' or 'nand' not allowed");
-               Error_Msg_Parse ("('nor' and 'nand' are not associative)");
+               Error_Msg_Parse
+                 ("sequence of 'nor' or 'nand' not allowed", Cont => True);
+               Error_Msg_Parse
+                 ("('nor' and 'nand' are not associative)");
             end if;
             if Op_Token /= Current_Token then
                --  Expression is a sequence of relations, with the same
@@ -4842,7 +4838,7 @@ package body Parse is
          --  Catch errors for Ada programmers.
          if Current_Token = Tok_Then or Current_Token = Tok_Else then
             Error_Msg_Parse ("""or else"" and ""and then"" sequences "
-                             & "are not allowed in vhdl");
+                             & "are not allowed in vhdl", Cont => True);
             Error_Msg_Parse ("""and"" and ""or"" are short-circuit "
                              & "operators for BIT and BOOLEAN types");
             Scan;
@@ -5558,8 +5554,8 @@ package body Parse is
          return Parenthesis_Name_To_Procedure_Call
            (Target, Iir_Kind_Procedure_Call_Statement);
       else
-         Error_Msg_Parse ("""<="" or "":="" expected instead of "
-                          & Image (Current_Token));
+         Error_Msg_Parse
+           ("""<="" or "":="" expected instead of %t", +Current_Token);
          Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement);
          Call := Create_Iir (Iir_Kind_Procedure_Call);
          Set_Prefix (Call, Target);
@@ -5980,8 +5976,10 @@ package body Parse is
 
       if Current_Token = Tok_Return then
          if Kind = Iir_Kind_Procedure_Declaration then
-            Error_Msg_Parse ("'return' not allowed for a procedure");
-            Error_Msg_Parse ("(remove return part or define a function)");
+            Error_Msg_Parse
+              ("'return' not allowed for a procedure", Cont => True);
+            Error_Msg_Parse
+              ("(remove return part or declare a function)");
 
             --  Skip 'return'
             Scan;
@@ -6192,7 +6190,7 @@ package body Parse is
             --  parenthesis.
             null;
          when others =>
-            Error_Msg_Parse ("incorrect formal name", Formal);
+            Error_Msg_Parse (+Formal, "incorrect formal name");
       end case;
    end Check_Formal_Form;
 
@@ -6370,7 +6368,8 @@ package body Parse is
    begin
       if Flags.Vhdl_Std = Vhdl_87 then
          Error_Msg_Parse
-           ("component instantiation using keyword 'component', 'entity',");
+           ("component instantiation using keyword 'component', 'entity',",
+           Cont => True);
          Error_Msg_Parse (" or 'configuration' is not allowed in vhdl87");
       end if;
 
@@ -8263,7 +8262,7 @@ package body Parse is
             Set_Identifier (Res, Get_Identifier (Name));
          else
             Set_Location (Res, Loc);
-            Error_Msg_Parse ("identifier for context expected", Name);
+            Error_Msg_Parse (+Name, "identifier for context expected");
          end if;
          Free_Iir (Name);
 
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index 7742dcfef..c172ab80b 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -10,7 +10,7 @@ package PSL.Errors is
      Errorout.Error_Kind;
 
    procedure Error_Msg_Parse (Msg: String)
-     renames Errorout.Error_Msg_Parse;
+     renames Errorout.Error_Msg_Parse_1;
    procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
      renames Errorout.Error_Msg_Sem;
 end PSL.Errors;
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index 7c5dbdd00..40fe9a4e7 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -422,10 +422,8 @@ package body Scanner is
                   --  as the remainder operator, instead of 'rem'.  This will
                   --  improve the error message.
                   Error_Msg_Scan
-                    ("'%' is not a vhdl operator, use 'rem'",
-                     File_Pos_To_Location
-                       (Current_Context.Source_File,
-                        Current_Context.Token_Pos));
+                    (Get_Token_Location,
+                     "'%%' is not a vhdl operator, use 'rem'");
                   Current_Token := Tok_Rem;
                   Pos := Current_Context.Token_Pos + 1;
                   return;
@@ -448,7 +446,7 @@ package body Scanner is
             --  that the enclosed sequence of characters constains no quotation
             --  marks, and provided that both string brackets are replaced.
             Error_Msg_Scan
-              ("'""' cannot be used in a string delimited with '%'");
+              ("'""' cannot be used in a string delimited with '%%'");
          end if;
 
          Length := Length + 1;
@@ -537,12 +535,12 @@ package body Scanner is
             when '"' =>
                pragma Assert (Mark = '%');
                Error_Msg_Scan
-                 ("'""' cannot close a bit string opened by '%'");
+                 ("'""' cannot close a bit string opened by '%%'");
                exit;
             when '%' =>
                pragma Assert (Mark = '"');
                Error_Msg_Scan
-                 ("'%' cannot close a bit string opened by '""'");
+                 ("'%%' cannot close a bit string opened by '""'");
                exit;
             when others =>
                if Characters_Kind (C) in Graphic_Character then
@@ -559,9 +557,9 @@ package body Scanner is
                else
                   if Mark = '%' then
                      Error_Msg_Scan
-                       ("'%' is not a vhdl operator, use 'rem'",
-                        File_Pos_To_Location
-                          (Current_Context.Source_File, Orig_Pos));
+                       (File_Pos_To_Location
+                          (Current_Context.Source_File, Orig_Pos),
+                        "'%%' is not a vhdl operator, use 'rem'");
                      Current_Token := Tok_Rem;
                      Pos := Orig_Pos + 1;
                      return;
@@ -857,7 +855,7 @@ package body Scanner is
          when Other_Special_Character | Special_Character =>
             if (C = '"' or C = '%') and then Len <= 2 then
                if C = '%' and Vhdl_Std >= Vhdl_08 then
-                  Error_Msg_Scan ("'%' not allowed in vhdl 2008 "
+                  Error_Msg_Scan ("'%%' not allowed in vhdl 2008 "
                                     & "(was replacement character)");
                   --  Continue as a bit string.
                end if;
@@ -933,9 +931,9 @@ package body Scanner is
                if not AMS_Vhdl then
                   if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
-                       ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ AMS-VHDL reserved word as an identifier",
-                       Warnid_Reserved_Word);
+                       (Warnid_Reserved_Word,
+                        "using %i AMS-VHDL reserved word as an identifier",
+                        +Current_Identifier);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
@@ -943,9 +941,9 @@ package body Scanner is
                if Vhdl_Std < Vhdl_08 then
                   if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
-                       ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl-2008 reserved word as an identifier",
-                       Warnid_Reserved_Word);
+                       (Warnid_Reserved_Word,
+                        "using %i vhdl-2008 reserved word as an identifier",
+                        +Current_Identifier);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
@@ -953,9 +951,9 @@ package body Scanner is
                if Vhdl_Std < Vhdl_00 then
                   if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
-                       ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl00 reserved word as an identifier",
-                        Warnid_Reserved_Word);
+                       (Warnid_Reserved_Word,
+                        "using %i vhdl-2000 reserved word as an identifier",
+                        +Current_Identifier);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
@@ -963,12 +961,12 @@ package body Scanner is
                if Vhdl_Std = Vhdl_87 then
                   if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
-                       ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl93 reserved word as a vhdl87 identifier",
-                        Warnid_Reserved_Word);
+                       (Warnid_Reserved_Word,
+                        "using %i vhdl93 reserved word as a vhdl87 identifier",
+                        +Current_Identifier, True);
                      Warning_Msg_Scan
-                       ("(use option --std=93 to compile as vhdl93)",
-                        Warnid_Reserved_Word);
+                       (Warnid_Reserved_Word,
+                        "(use option --std=93 to compile as vhdl93)");
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
@@ -1155,7 +1153,7 @@ package body Scanner is
                        or else I = Nam_Length - 1
                      then
                         Error_Msg_Option ("anti-slash must be doubled "
-                                          & "in extended identifier");
+                                            & "in extended identifier");
                         return;
                      end if;
                   end if;
@@ -1469,8 +1467,8 @@ package body Scanner is
                         --  the start of a nested delimited comment.
                         if Source (Pos + 1) = '*' then
                            Warning_Msg_Scan
-                             ("'/*' found within a block comment",
-                             Warnid_Nested_Comment);
+                             (Warnid_Nested_Comment,
+                              "'/*' found within a block comment");
                         end if;
                         Pos := Pos + 1;
                      when '*' =>
@@ -1488,10 +1486,8 @@ package body Scanner is
                         if Pos >= Current_Context.File_Len then
                            --  Point at the start of the comment.
                            Error_Msg_Scan
-                             ("block comment not terminated at end of file",
-                              File_Pos_To_Location
-                                (Current_Context.Source_File,
-                                 Current_Context.Token_Pos));
+                             (Get_Token_Location,
+                              "block comment not terminated at end of file");
                            exit;
                         end if;
                         Pos := Pos + 1;
@@ -1713,7 +1709,7 @@ package body Scanner is
          when '%' =>
             if Vhdl_Std >= Vhdl_08 then
                Error_Msg_Scan
-                 ("'%' not allowed in vhdl 2008 (was replacement character)");
+                 ("'%%' not allowed in vhdl 2008 (was replacement character)");
                --  Continue as a string.
             end if;
             Scan_String;
@@ -1843,8 +1839,9 @@ package body Scanner is
          when '$' | '`'
            | Inverted_Exclamation .. Inverted_Question
            | Multiplication_Sign | Division_Sign =>
-            Error_Msg_Scan ("character """ & Source (Pos)
-                            & """ can only be used in strings or comments");
+            Error_Msg_Scan
+              ("character %c can only be used in strings or comments",
+               +Source (Pos));
             Pos := Pos + 1;
             goto Again;
          when '@' =>
@@ -1854,8 +1851,8 @@ package body Scanner is
                return;
             else
                Error_Msg_Scan
-                 ("character """ & Source (Pos)
-                    & """ can only be used in strings or comments");
+                 ("character %c can only be used in strings or comments",
+                  +Source (Pos));
                Pos := Pos + 1;
                goto Again;
             end if;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index d19061846..6cb547ec2 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -1906,8 +1906,9 @@ package body Sem is
                     and then Get_Pure_Flag (Subprg)
                   then
                      Error_Msg_Sem_Relaxed
-                       ("result subtype of a pure function cannot denote an"
-                          & " access type", Subprg);
+                       (Subprg,
+                        "result subtype of a pure function cannot denote an"
+                          & " access type");
                   end if;
                when others =>
                   if  Vhdl_Std >= Vhdl_08
@@ -1915,8 +1916,8 @@ package body Sem is
                     and then Get_Pure_Flag (Subprg)
                   then
                      Error_Msg_Sem_Relaxed
-                       ("result subtype of a pure function cannot have"
-                          & " access subelements", Subprg);
+                       (Subprg, "result subtype of a pure function cannot have"
+                          & " access subelements");
                   end if;
             end case;
 
@@ -2461,17 +2462,17 @@ package body Sem is
                      Callees := Get_Callees_List (El);
                      pragma Assert (Callees /= Null_Iir_List);
                      Warning_Msg_Sem
-                       ("can't assert that all calls in " & Disp_Node (El)
-                        & " are pure or have not wait; "
-                          & "will be checked at elaboration", El,
-                        Warnid_Delayed_Checks);
+                       (Warnid_Delayed_Checks, +El,
+                        "can't assert that all calls in " & Disp_Node (El)
+                          & " are pure or have not wait; "
+                          & "will be checked at elaboration");
                      Callee := Get_Nth_Element (Callees, 0);
                      --  FIXME: could improve this message by displaying the
                      --  chain of calls until the first subprograms in
                      --  unknown state.
                      Warning_Msg_Sem
-                       ("(first such call is to " & Disp_Node (Callee) & ")",
-                        Callee, Warnid_Delayed_Checks);
+                       (Warnid_Delayed_Checks, +Callee,
+                        "(first such call is to " & Disp_Node (Callee) & ")");
                   end if;
                end if;
             when Iir_Kind_Sensitized_Process_Statement =>
@@ -2479,9 +2480,9 @@ package body Sem is
                   Keep := True;
                   if Emit_Warnings then
                      Warning_Msg_Sem
-                       ("can't assert that " & Disp_Node (El)
-                          & " has not wait; will be checked at elaboration",
-                        El, Warnid_Delayed_Checks);
+                       (Warnid_Delayed_Checks, +El,
+                        "can't assert that " & Disp_Node (El)
+                          & " has not wait; will be checked at elaboration");
                   end if;
                end if;
             when others =>
@@ -2635,8 +2636,8 @@ package body Sem is
       --  Emit a warning is a body is not necessary.
       if not Get_Need_Body (Package_Decl) then
          Warning_Msg_Sem
-           (Disp_Node (Package_Decl) & " does not require a body",
-            Decl, Warnid_Body);
+           (Warnid_Body, +Decl,
+            Disp_Node (Package_Decl) & " does not require a body");
       end if;
 
       Set_Package (Decl, Package_Decl);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 48c3ae2d9..a78f52b6e 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1823,8 +1823,8 @@ package body Sem_Decls is
                   --  shared variable declaration must be a protected type.
                   if Get_Shared_Flag (Decl) and not Is_Protected then
                      Error_Msg_Sem_Relaxed
-                       ("type of a shared variable must be a protected type",
-                        Decl);
+                       (Decl,
+                        "type of a shared variable must be a protected type");
                   end if;
 
                   --  LRM00 4.3.1.3  Variable declarations
@@ -1973,7 +1973,7 @@ package body Sem_Decls is
                Spec := Get_Subprogram_Specification (Parent);
                if Get_Pure_Flag (Spec) then
                   Error_Msg_Sem_Relaxed
-                    ("cannot declare a file in a pure function", Decl);
+                    (Decl, "cannot declare a file in a pure function");
                end if;
             when Iir_Kind_Procedure_Body =>
                Spec := Get_Subprogram_Specification (Parent);
@@ -3078,9 +3078,8 @@ package body Sem_Decls is
                     and then not Is_Implicit_Subprogram (El)
                     and then not Is_Second_Subprogram_Specification (El)
                   then
-                     Warning_Msg_Sem
-                       (Disp_Node (El) & " is never referenced", El,
-                       Warnid_Unused);
+                     Warning_Msg_Sem (Warnid_Unused, +El,
+                                      Disp_Node (El) & " is never referenced");
                   end if;
                when others =>
                   null;
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 10e07bf22..381068e88 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -862,8 +862,9 @@ package body Sem_Expr is
             --  eg: for i in -1 to 1 loop
 
             --  Be tolerant.
-            Warning_Msg_Sem ("universal integer bound must be numeric literal "
-                               & "or attribute", Res, Warnid_Universal);
+            Warning_Msg_Sem (Warnid_Universal, +Res,
+                             "universal integer bound must be numeric literal "
+                               & "or attribute");
          else
             Error_Msg_Sem ("universal integer bound must be numeric literal "
                              & "or attribute", Res);
@@ -3431,9 +3432,8 @@ package body Sem_Expr is
                      if not Eval_Is_In_Bound (Expr, Element_Type)
                      then
                         Info.Has_Bound_Error := True;
-                        Warning_Msg_Sem
-                          ("element is out of the bounds", Expr,
-                           Warnid_Runtime_Error);
+                        Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+                                         "element is out of the bounds");
                      end if;
 
                      --  FIXME: handle name/others in translate.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 098268daa..b723782c1 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -734,9 +734,9 @@ package body Sem_Names is
       then
          if False and then Flags.Vhdl_Std = Vhdl_87 then
             -- emit a warning for a null slice.
-            Warning_Msg_Sem
-              ("direction mismatch results in a null slice",
-               Name, Warnid_Runtime_Error);
+            Warning_Msg_Sem (Warnid_Runtime_Error, +Name,
+                             "direction mismatch results in a null slice");
+
          end if;
          Error_Msg_Sem ("direction of the range mismatch", Name);
       end if;
@@ -1310,8 +1310,8 @@ package body Sem_Names is
       is
       begin
          Error_Msg_Sem_Relaxed
-           ("reference to " & Disp_Node (Obj) & " violate pure rule for "
-            & Disp_Node (Subprg), Loc);
+           (Loc, "reference to " & Disp_Node (Obj) & " violate pure rule for "
+              & Disp_Node (Subprg));
       end Error_Pure;
 
       Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index 8b4a525f0..66aa7e17f 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -772,8 +772,8 @@ package body Sem_Specs is
          Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, True);
          if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
             Warning_Msg_Sem
-              ("attribute specification apply to no named entity",
-               Spec, Warnid_Specs);
+              (Warnid_Specs, +Spec,
+               "attribute specification apply to no named entity");
          end if;
       elsif List = Iir_List_Others then
          --  o If the reserved word OTHERS is supplied, then the attribute
@@ -785,8 +785,8 @@ package body Sem_Specs is
          Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, False);
          if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
             Warning_Msg_Sem
-              ("attribute specification apply to no named entity",
-               Spec, Warnid_Specs);
+              (Warnid_Specs, +Spec,
+               "attribute specification apply to no named entity");
          end if;
       else
          --  o If a list of entity designators is supplied, then the
@@ -1341,8 +1341,8 @@ package body Sem_Specs is
          if not Apply_Component_Specification (Parent_Stmts, False)
            and then Is_Warning_Enabled (Warnid_Specs)
          then
-            Warning_Msg_Sem ("component specification applies to no instance",
-                             Spec, Warnid_Specs);
+            Warning_Msg_Sem (Warnid_Specs, +Spec,
+                             "component specification applies to no instance");
          end if;
       elsif List = Iir_List_Others then
          --  LRM93 5.2
@@ -1359,8 +1359,8 @@ package body Sem_Specs is
          if not Apply_Component_Specification (Parent_Stmts, True)
            and then Is_Warning_Enabled (Warnid_Specs)
          then
-            Warning_Msg_Sem ("component specification applies to no instance",
-                             Spec, Warnid_Specs);
+            Warning_Msg_Sem (Warnid_Specs, +Spec,
+                             "component specification applies to no instance");
          end if;
       else
          --  LRM93 5.2
@@ -1788,9 +1788,9 @@ package body Sem_Specs is
          --     the instantiated component and that is directly visible
          --     (see 10.3),
          Decl := Get_Declaration (Inter);
-         Warning_Msg_Elab ("visible declaration for " & Name_Table.Image (Name)
-                             & " is " & Disp_Node (Decl),
-                           Decl, Warnid_Default_Binding);
+         Warning_Msg_Elab
+           (Warnid_Default_Binding, Decl,
+            "visible declaration for " & Name_Table.Image (Name));
 
          --  b)  An entity declaration that has the same simple name that of
          --      the instantiated component and that would be directly
@@ -1801,9 +1801,9 @@ package body Sem_Specs is
             Inter := Get_Under_Interpretation (Name);
             if Valid_Interpretation (Inter) then
                Decl := Get_Declaration (Inter);
-               Warning_Msg_Elab
-                 ("interpretation behind the component is " & Disp_Node (Decl),
-                  Comp, Warnid_Default_Binding);
+               Warning_Msg_Elab (Warnid_Default_Binding, Comp,
+                                 "interpretation behind the component is "
+                                   & Disp_Node (Decl));
             end if;
          end if;
       end if;
@@ -1822,8 +1822,9 @@ package body Sem_Specs is
             Decl := Get_Parent (Decl);
          end loop;
 
-         Warning_Msg_Elab ("no entity """ & Name_Table.Image (Name) & """ in "
-                           & Disp_Node (Decl), Comp, Warnid_Default_Binding);
+         Warning_Msg_Elab (Warnid_Default_Binding, Comp,
+                           "no entity """ & Name_Table.Image (Name) & """ in "
+                             & Disp_Node (Decl));
       end if;
    end Explain_No_Visible_Entity;
 
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index 25c1ada95..3b2346cee 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -556,8 +556,9 @@ package body Sem_Stmts is
                     | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
                      if Get_Postponed_Flag (Current_Concurrent_Statement) then
                         Warning_Msg_Sem
-                          ("waveform may cause a delta cycle in a " &
-                             "postponed process", We, Warnid_Delta_Cycle);
+                          (Warnid_Delta_Cycle, +We,
+                           "waveform may cause a delta cycle in a " &
+                             "postponed process");
                      end if;
                   when others =>
                      --  Context is a subprogram.
@@ -832,8 +833,8 @@ package body Sem_Stmts is
                     and then not Check_Implicit_Conversion (Target_Type, Expr)
                   then
                      Warning_Msg_Sem
-                       ("expression length does not match target length",
-                        Stmt, Warnid_Runtime_Error);
+                       (Warnid_Runtime_Error, +Stmt,
+                        "expression length does not match target length");
                      Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
                   end if;
                end if;
@@ -1502,9 +1503,9 @@ package body Sem_Stmts is
             if Is_Warning_Enabled (Warnid_Default_Binding)
               and then not Flags.Flag_Elaborate
             then
-               Warning_Msg_Sem
-                 ("no default binding for instantiation of "
-                    & Disp_Node (Decl), Stmt, Warnid_Default_Binding);
+               Warning_Msg_Sem (Warnid_Default_Binding, +Stmt,
+                                "no default binding for instantiation of "
+                                  & Disp_Node (Decl));
                Explain_No_Visible_Entity (Decl);
             end if;
          elsif Flags.Flag_Elaborate
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index b5f948038..93d60d928 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -1892,7 +1892,7 @@ package body Elaboration is
       --  such a design entity.
       if not Is_Fully_Bound (Conf) then
          Warning_Msg_Elab
-           (Disp_Node (Stmt) & " not bound", Stmt, Warnid_Binding);
+           (Warnid_Binding, Stmt, Disp_Node (Stmt) & " not bound");
          return;
       end if;
 
@@ -1950,16 +1950,17 @@ package body Elaboration is
          if Arch_Name = Null_Identifier then
             Arch := Libraries.Get_Latest_Architecture (Entity);
             if Arch = Null_Iir then
-               Error_Msg_Elab ("no architecture analysed for "
-                                 & Disp_Node (Entity), Stmt);
+               Error_Msg_Elab (Stmt, "no architecture analysed for "
+                                 & Disp_Node (Entity));
             end if;
             Arch_Name := Get_Identifier (Arch);
          end if;
          Arch_Design := Libraries.Load_Secondary_Unit
            (Get_Design_Unit (Entity), Arch_Name, Stmt);
          if Arch_Design = Null_Iir then
-            Error_Msg_Elab ("no architecture `" & Name_Table.Image (Arch_Name)
-                              & "' for " & Disp_Node (Entity), Stmt);
+            Error_Msg_Elab (Stmt,
+                            "no architecture `" & Name_Table.Image (Arch_Name)
+                              & "' for " & Disp_Node (Entity));
          end if;
          Arch := Get_Library_Unit (Arch_Design);
       end if;
@@ -2815,8 +2816,8 @@ package body Elaboration is
               and then not Is_Fully_Constrained_Type (Get_Type (Formal))
             then
                Error_Msg_Elab
-                 ("top-level " & Disp_Node (Formal) & " must have a value",
-                  Formal);
+                 (Formal,
+                  "top-level " & Disp_Node (Formal) & " must have a value");
             end if;
          end if;
          Assoc := Get_Chain (Assoc);
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index a788255d8..936cbd3f3 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -1470,8 +1470,8 @@ package body Execution is
             end;
 
          when others =>
-            Error_Msg_Elab ("execute_implicit_function: unimplemented " &
-                              Iir_Predefined_Functions'Image (Func), Expr);
+            Error_Msg_Elab (Expr, "execute_implicit_function: unimplemented " &
+                              Iir_Predefined_Functions'Image (Func));
             raise Internal_Error;
       end case;
       return Result;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index e1ae36901..451dfcba6 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -516,7 +516,7 @@ package body Trans.Chap7 is
    exception
       when Constraint_Error =>
          --  Can be raised by Get_Physical_Value.
-         Error_Msg_Elab ("numeric literal not in range", Expr);
+         Error_Msg_Elab (Expr, "numeric literal not in range");
          return New_Signed_Literal (Res_Type, 0);
    end Translate_Numeric_Literal;
 
@@ -3784,8 +3784,8 @@ package body Trans.Chap7 is
                return New_Lit (New_Signed_Literal (Otype, Integer_64 (Val)));
             exception
                when Constraint_Error =>
-                  Warning_Msg_Elab ("physical literal out of range",
-                                    Expr, Warnid_Runtime_Error);
+                  Warning_Msg_Elab (Warnid_Runtime_Error, Expr,
+                                    "physical literal out of range");
                   return Translate_Overflow_Literal (Expr);
             end;