errorout: split and rework.

7 files changed, 457 insertions, 328 deletions

diff --git a/src/vhdl/errorout-console.adb b/src/vhdl/errorout-console.adb
new file mode 100644
index 000000000..194b80ea4
--- /dev/null
+++ b/src/vhdl/errorout-console.adb
@@ -0,0 +1,274 @@
+--  Output errors on the console.
+--  Copyright (C) 2018 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 GNAT.OS_Lib;
+with Name_Table;
+with Files_Map; use Files_Map;
+with Flags; use Flags;
+
+package body Errorout.Console is
+   --  Name of the program, used to report error message.
+   Program_Name : String_Acc := null;
+
+   --  Terminal.
+
+   --  Set Flag_Color_Diagnostics to On or Off if is was Auto.
+   procedure Detect_Terminal
+   is
+      --  Import isatty.
+      function isatty (Fd : Integer) return Integer;
+      pragma Import (C, isatty);
+
+      --  Awful way to detect if the host is Windows.  Should be replaced by
+      --  a host-specific package.
+      Is_Windows : constant Boolean := GNAT.OS_Lib.Directory_Separator = '\';
+   begin
+      if Flag_Color_Diagnostics = Auto then
+         if Is_Windows then
+            --  Off by default on Windows, as the consoles may not support
+            --  ANSI control sequences.  Should be replaced by calls to the
+            --  Win32 API.
+            Flag_Color_Diagnostics := Off;
+         else
+            --  On Linux/Unix/Mac OS X: use color only when the output is to a
+            --  tty.
+            if isatty (2) /= 0 then
+               Flag_Color_Diagnostics := On;
+            else
+               Flag_Color_Diagnostics := Off;
+            end if;
+         end if;
+      end if;
+   end Detect_Terminal;
+
+   --  Color to be used for various part of messages.
+   type Color_Type is (Color_Locus,
+                       Color_Note, Color_Warning, Color_Error, Color_Fatal,
+                       Color_Message,
+                       Color_None);
+
+   --  Switch to COLOR.
+   procedure Set_Color (Color : Color_Type)
+   is
+      procedure Put (S : String)
+      is
+         use Ada.Text_IO;
+      begin
+         Put (Standard_Error, S);
+      end Put;
+   begin
+      if Flag_Color_Diagnostics = Off then
+         return;
+      end if;
+
+      --  Use ANSI sequences.
+      --  They are also documented on msdn in 'Console Virtual Terminal
+      --  sequences'.
+
+      Put (ASCII.ESC & '[');
+      case Color is
+         when Color_Locus   => Put ("1");    --  Bold
+         when Color_Note    => Put ("1;36"); --  Bold, cyan
+         when Color_Warning => Put ("1;35"); --  Bold, magenta
+         when Color_Error   => Put ("1;31"); --  Bold, red
+         when Color_Fatal   => Put ("1;33"); --  Bold, yellow
+         when Color_Message => Put ("0;1");  --  Normal, bold
+         when Color_None    => Put ("0");    --  Normal
+      end case;
+      Put ("m");
+   end Set_Color;
+
+   Msg_Len : Natural;
+   Current_Error : Error_Record;
+
+   procedure Put (Str : String)
+   is
+      use Ada.Text_IO;
+   begin
+      Msg_Len := Msg_Len + Str'Length;
+      Put (Standard_Error, Str);
+   end Put;
+
+   procedure Put (C : Character)
+   is
+      use Ada.Text_IO;
+   begin
+      Msg_Len := Msg_Len + 1;
+      Put (Standard_Error, C);
+   end Put;
+
+   procedure Put_Line (Str : String := "")
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line (Standard_Error, Str);
+      Msg_Len := 0;
+   end Put_Line;
+
+   procedure Set_Program_Name (Name : String) is
+   begin
+      Program_Name := new String'(Name);
+   end Set_Program_Name;
+
+   procedure Disp_Program_Name is
+   begin
+      if Program_Name /= null then
+         Put (Program_Name.all);
+         Put (':');
+      end if;
+   end Disp_Program_Name;
+
+   procedure Disp_Location (File: Name_Id; Line: Natural; Col: Natural) is
+   begin
+      if File = Null_Identifier then
+         Put ("??");
+      else
+         Put (Name_Table.Image (File));
+      end if;
+      Put (':');
+      Put (Natural_Image (Line));
+      Put (':');
+      Put (Natural_Image (Col));
+      Put (':');
+   end Disp_Location;
+
+   procedure Console_Error_Start (E : Error_Record)
+   is
+      --- Coord_To_Position (File, Line_Pos, Offset, Name, Col);
+      Progname : Boolean;
+   begin
+      Current_Error := E;
+
+      Detect_Terminal;
+
+      --  And no program name.
+      Progname := False;
+
+      case E.Origin is
+         when Option
+           | Library =>
+            pragma Assert (E.File = No_Source_File_Entry);
+            Progname := True;
+         when Elaboration =>
+            if E.File = No_Source_File_Entry then
+               Progname := True;
+            end if;
+         when others =>
+            pragma Assert (E.File /= No_Source_File_Entry);
+            null;
+      end case;
+
+      Msg_Len := 0;
+
+      if Flag_Color_Diagnostics = On then
+         Set_Color (Color_Locus);
+      end if;
+
+      if Progname then
+         Disp_Program_Name;
+      elsif E.File /= No_Source_File_Entry then
+         Disp_Location (Get_File_Name (E.File), E.Line, Get_Error_Col (E));
+      else
+         Disp_Location (Null_Identifier, 0, 0);
+      end if;
+
+      --  Display level.
+      declare
+         Id_Level : Msgid_Type;
+      begin
+         if Flags.Warn_Error
+           and then (E.Id = Msgid_Warning or E.Id in Msgid_Warnings)
+         then
+            Id_Level := Msgid_Error;
+         else
+            Id_Level := E.Id;
+         end if;
+
+         case Id_Level is
+            when Msgid_Note =>
+               if Flag_Color_Diagnostics = On then
+                  Set_Color (Color_Note);
+               end if;
+               Put ("note:");
+            when Msgid_Warning | Msgid_Warnings =>
+               if Flag_Color_Diagnostics = On then
+                  Set_Color (Color_Warning);
+               end if;
+               Put ("warning:");
+            when Msgid_Error =>
+               Nbr_Errors := Nbr_Errors + 1;
+               if Flag_Color_Diagnostics = On then
+                  Set_Color (Color_Error);
+               end if;
+               if Msg_Len = 0
+                 or else Flag_Color_Diagnostics = On
+               then
+                  --  'error:' is displayed only if not location is present, or
+                  --  if messages are colored.
+                  Put ("error:");
+               end if;
+            when Msgid_Fatal =>
+               if Flag_Color_Diagnostics = On then
+                  Set_Color (Color_Fatal);
+               end if;
+               Put ("fatal:");
+         end case;
+      end;
+
+      if Flag_Color_Diagnostics = On then
+         Set_Color (Color_Message);
+      end if;
+      Put (' ');
+   end Console_Error_Start;
+
+   procedure Console_Message (Str : String) renames Put;
+
+   procedure Console_Message_End is
+   begin
+      if Flag_Diagnostics_Show_Option
+        and then Current_Error.Id in Msgid_Warnings
+      then
+         Put (" [-W");
+         Put (Warning_Image (Current_Error.Id));
+         Put ("]");
+      end if;
+
+      if Flag_Color_Diagnostics = On then
+         Set_Color (Color_None);
+      end if;
+
+      Put_Line;
+
+      if Flag_Caret_Diagnostics
+        and then (Current_Error.File /= No_Source_File_Entry
+                    and Current_Error.Line /= 0)
+      then
+         Put_Line (Extract_Expanded_Line (Current_Error.File,
+                                          Current_Error.Line));
+         Put_Line ((1 .. Get_Error_Col (Current_Error) - 1 => ' ') & '^');
+      end if;
+   end Console_Message_End;
+
+   procedure Install_Handler is
+   begin
+      Set_Report_Handler ((Errorout.Console.Console_Error_Start'Access,
+                           Errorout.Console.Console_Message'Access,
+                           Errorout.Console.Console_Message_End'Access));
+   end Install_Handler;
+end Errorout.Console;
diff --git a/src/vhdl/errorout-console.ads b/src/vhdl/errorout-console.ads
new file mode 100644
index 000000000..9ec2f6d80
--- /dev/null
+++ b/src/vhdl/errorout-console.ads
@@ -0,0 +1,31 @@
+--  Output errors on the console.
+--  Copyright (C) 2018 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.
+
+package Errorout.Console is
+   --  Set the program name, used in error messages for options.  Not displayed
+   --  if not initialized.
+   procedure Set_Program_Name (Name : String);
+
+   --  Report handle for the console.
+   procedure Console_Error_Start (E : Error_Record);
+   procedure Console_Message (Str : String);
+   procedure Console_Message_End;
+
+   --  Install the handlers for reporting errors.
+   procedure Install_Handler;
+end Errorout.Console;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index a86eb890b..64b0d8d0b 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -17,7 +17,6 @@
 --  02111-1307, USA.
 
 with Ada.Text_IO;
-with GNAT.OS_Lib;
 with Scanner;
 with Name_Table;
 with Iirs_Utils; use Iirs_Utils;
@@ -29,76 +28,59 @@ with PSL.Nodes;
 with Str_Table;
 
 package body Errorout is
-   --  Name of the program, used to report error message.
-   Program_Name : String_Acc := null;
-
-   --  Terminal.
+   procedure Error_Kind (Msg : String; An_Iir : Iir)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line
+        (Standard_Error,
+         Msg & ": cannot handle " & Iir_Kind'Image (Get_Kind (An_Iir))
+           & " (" & Disp_Location (An_Iir) & ')');
+      raise Internal_Error;
+   end Error_Kind;
 
-   --  Set Flag_Color_Diagnostics to On or Off if is was Auto.
-   procedure Detect_Terminal
+   procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions)
    is
-      --  Import isatty.
-      function isatty (Fd : Integer) return Integer;
-      pragma Import (C, isatty);
+      use Ada.Text_IO;
+   begin
+      Put_Line
+        (Standard_Error,
+         Msg & ": cannot handle " & Iir_Predefined_Functions'Image (Def));
+      raise Internal_Error;
+   end Error_Kind;
 
-      --  Awful way to detect if the host is Windows.  Should be replaced by
-      --  a host-specific package.
-      Is_Windows : constant Boolean := GNAT.OS_Lib.Directory_Separator = '\';
+   procedure Error_Kind (Msg : String; N : PSL_Node)
+   is
+      use Ada.Text_IO;
    begin
-      if Flag_Color_Diagnostics = Auto then
-         if Is_Windows then
-            --  Off by default on Windows, as the consoles may not support
-            --  ANSI control sequences.  Should be replaced by calls to the
-            --  Win32 API.
-            Flag_Color_Diagnostics := Off;
-         else
-            --  On Linux/Unix/Mac OS X: use color only when the output is to a
-            --  tty.
-            if isatty (2) /= 0 then
-               Flag_Color_Diagnostics := On;
-            else
-               Flag_Color_Diagnostics := Off;
-            end if;
-         end if;
-      end if;
-   end Detect_Terminal;
+      Put (Standard_Error, Msg);
+      Put (Standard_Error, ": cannot handle ");
+      Put_Line (Standard_Error,
+                PSL.Nodes.Nkind'Image (PSL.Nodes.Get_Kind (N)));
+      raise Internal_Error;
+   end Error_Kind;
 
-   --  Color to be used for various part of messages.
-   type Color_Type is (Color_Locus,
-                       Color_Note, Color_Warning, Color_Error, Color_Fatal,
-                       Color_Message,
-                       Color_None);
+   function Natural_Image (Val: Natural) return String
+   is
+      Str: constant String := Natural'Image (Val);
+   begin
+      return Str (Str'First + 1 .. Str'Last);
+   end Natural_Image;
 
-   --  Switch to COLOR.
-   procedure Set_Color (Color : Color_Type)
+   function Get_Error_Col (E : Error_Record) return Natural
    is
-      procedure Put (S : String)
-      is
-         use Ada.Text_IO;
-      begin
-         Put (Standard_Error, S);
-      end Put;
+      Line_Pos : Source_Ptr;
    begin
-      if Flag_Color_Diagnostics = Off then
-         return;
-      end if;
+      Line_Pos := Line_To_Position (E.File, E.Line);
+      return Coord_To_Col (E.File, Line_Pos, E.Offset);
+   end Get_Error_Col;
 
-      --  Use ANSI sequences.
-      --  They are also documented on msdn in 'Console Virtual Terminal
-      --  sequences'.
-
-      Put (ASCII.ESC & '[');
-      case Color is
-         when Color_Locus   => Put ("1");    --  Bold
-         when Color_Note    => Put ("1;36"); --  Bold, cyan
-         when Color_Warning => Put ("1;35"); --  Bold, magenta
-         when Color_Error   => Put ("1;31"); --  Bold, red
-         when Color_Fatal   => Put ("1;33"); --  Bold, yellow
-         when Color_Message => Put ("0;1");  --  Normal, bold
-         when Color_None    => Put ("0");    --  Normal
-      end case;
-      Put ("m");
-   end Set_Color;
+   Report_Handler : Report_Msg_Handler;
+
+   procedure Set_Report_Handler (Handler : Report_Msg_Handler) is
+   begin
+      Report_Handler := Handler;
+   end Set_Report_Handler;
 
    --  Warnings.
 
@@ -211,90 +193,6 @@ package body Errorout is
       end if;
    end "+";
 
-   Msg_Len : Natural;
-
-   procedure Put (Str : String)
-   is
-      use Ada.Text_IO;
-   begin
-      Msg_Len := Msg_Len + Str'Length;
-      Put (Standard_Error, Str);
-   end Put;
-
-   procedure Put (C : Character)
-   is
-      use Ada.Text_IO;
-   begin
-      Msg_Len := Msg_Len + 1;
-      Put (Standard_Error, C);
-   end Put;
-
-   procedure Put_Line (Str : String := "")
-   is
-      use Ada.Text_IO;
-   begin
-      Put_Line (Standard_Error, Str);
-      Msg_Len := 0;
-   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_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 Disp_Location
-     (File: Name_Id; Line: Natural; Col: Natural) is
-   begin
-      if File = Null_Identifier then
-         Put ("??");
-      else
-         Put (Name_Table.Image (File));
-      end if;
-      Put (':');
-      Disp_Natural (Line);
-      Put (':');
-      Disp_Natural (Col);
-      Put (':');
-   end Disp_Location;
-
-   procedure Set_Program_Name (Name : String) is
-   begin
-      Program_Name := new String'(Name);
-   end Set_Program_Name;
-
-   procedure Disp_Program_Name is
-   begin
-      if Program_Name /= null then
-         Put (Program_Name.all);
-         Put (':');
-      end if;
-   end Disp_Program_Name;
-
    procedure Report_Msg (Id : Msgid_Type;
                          Origin : Report_Origin;
                          Loc : Location_Type;
@@ -302,7 +200,6 @@ package body Errorout is
                          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;
@@ -318,116 +215,45 @@ package body Errorout is
 
       File : Source_File_Entry;
       Line : Natural;
-      Col : Natural;
-      Progname : Boolean;
+      Offset : Natural;
+      Line_Pos : Source_Ptr;
+      pragma Unreferenced (Line_Pos);
    begin
-      --  By default, no location.
       File := No_Source_File_Entry;
       Line := 0;
-      Col := 0;
-
-      --  And no program name.
-      Progname := False;
-
-      Detect_Terminal;
+      Offset := 0;
 
       case Origin is
          when Option
            | Library =>
-            Progname := True;
-         when Elaboration =>
-            if Loc = No_Location then
-               Progname := True;
-            else
-               Location_To_Position (Loc, File, Line, Col);
-            end if;
-         when Scan =>
-            if Loc = No_Location then
-               File := Scanner.Get_Current_Source_File;
-               Line := Scanner.Get_Current_Line;
-               Col := Scanner.Get_Current_Column;
-            else
-               Location_To_Position (Loc, File, Line, Col);
-            end if;
-         when Parse =>
-            if Loc = No_Location then
-               File := Scanner.Get_Current_Source_File;
-               Line := Scanner.Get_Current_Line;
-               Col := Scanner.Get_Token_Column;
-            else
-               Location_To_Position (Loc, File, Line, Col);
-            end if;
-         when Semantic =>
-            if Loc = No_Location then
-               File := No_Source_File_Entry;
-               Line := 0;
-               Col := 0;
+            pragma Assert (Loc = No_Location);
+            null;
+         when others =>
+            if Loc /= No_Location then
+               Location_To_Coord (Loc, File, Line_Pos, Line, Offset);
             else
-               Location_To_Position (Loc, File, Line, Col);
+               case Origin is
+                  when Option
+                    | Library =>
+                     raise Program_Error;
+                  when Elaboration =>
+                     null;
+                  when Scan =>
+                     File := Scanner.Get_Current_Source_File;
+                     Line := Scanner.Get_Current_Line;
+                     Offset  := Scanner.Get_Current_Offset;
+                  when Parse =>
+                     File := Scanner.Get_Current_Source_File;
+                     Line := Scanner.Get_Current_Line;
+                     Offset  := Scanner.Get_Token_Offset;
+                  when Semantic =>
+                     null;
+               end case;
             end if;
       end case;
 
-      Msg_Len := 0;
-
-      if Flag_Color_Diagnostics = On then
-         Set_Color (Color_Locus);
-      end if;
-
-      if Progname then
-         Disp_Program_Name;
-      elsif File /= No_Source_File_Entry then
-         Disp_Location (Get_File_Name (File), Line, Col);
-      else
-         Disp_Location (Null_Identifier, 0, 0);
-      end if;
-
-      --  Display level.
-      declare
-         Id_Level : Msgid_Type;
-      begin
-         if Flags.Warn_Error
-           and then (Id = Msgid_Warning or Id in Msgid_Warnings)
-         then
-            Id_Level := Msgid_Error;
-         else
-            Id_Level := Id;
-         end if;
-
-         case Id_Level is
-            when Msgid_Note =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Note);
-               end if;
-               Put ("note:");
-            when Msgid_Warning | Msgid_Warnings =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Warning);
-               end if;
-               Put ("warning:");
-            when Msgid_Error =>
-               Nbr_Errors := Nbr_Errors + 1;
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Error);
-               end if;
-               if Msg_Len = 0
-                 or else Flag_Color_Diagnostics = On
-               then
-                  --  'error:' is displayed only if not location is present, or
-                  --  if messages are colored.
-                  Put ("error:");
-               end if;
-            when Msgid_Fatal =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Fatal);
-               end if;
-               Put ("fatal:");
-         end case;
-      end;
-
-      if Flag_Color_Diagnostics = On then
-         Set_Color (Color_Message);
-      end if;
-      Put (' ');
+      Report_Handler.Error_Start
+        (Err => (Origin, File, Line, Offset, Id, Cont));
 
       --  Display message.
       declare
@@ -439,13 +265,13 @@ package body Errorout is
          Argn := Args'First;
          while N <= Msg'Last loop
             if Msg (N) = '%' then
-               Put (Msg (First .. N - 1));
+               Report_Handler.Message (Msg (First .. N - 1));
                First := N + 2;
                pragma Assert (N < Msg'Last);
                N := N + 1;
                case Msg (N) is
                   when '%' =>
-                     Put ('%');
+                     Report_Handler.Message ("%");
                      Argn := Argn - 1;
                   when 'i' =>
                      --  Identifier.
@@ -453,7 +279,7 @@ package body Errorout is
                         Arg : Earg_Type renames Args (Argn);
                         Id : Name_Id;
                      begin
-                        Put ('"');
+                        Report_Handler.Message ("""");
                         case Arg.Kind is
                            when Earg_Iir =>
                               Id := Get_Identifier (Arg.Val_Iir);
@@ -463,23 +289,23 @@ package body Errorout is
                               --  Invalid conversion to identifier.
                               raise Internal_Error;
                         end case;
-                        Put (Name_Table.Image (Id));
-                        Put ('"');
+                        Report_Handler.Message (Name_Table.Image (Id));
+                        Report_Handler.Message ("""");
                      end;
                   when 'c' =>
                      --  Character
                      declare
                         Arg : Earg_Type renames Args (Argn);
                      begin
-                        Put (''');
+                        Report_Handler.Message ("'");
                         case Arg.Kind is
                            when Earg_Char =>
-                              Put (Arg.Val_Char);
+                              Report_Handler.Message ((1 => Arg.Val_Char));
                            when others =>
                               --  Invalid conversion to character.
                               raise Internal_Error;
                         end case;
-                        Put (''');
+                        Report_Handler.Message ("'");
                      end;
                   when 't' =>
                      --  A token
@@ -495,13 +321,16 @@ package body Errorout is
                               --  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;
+                        case Tok is
+                           when Tok_Identifier =>
+                              Report_Handler.Message ("an identifier");
+                           when Tok_Eof =>
+                              Report_Handler.Message ("end of file");
+                           when others =>
+                              Report_Handler.Message ("'");
+                              Report_Handler.Message (Image (Tok));
+                              Report_Handler.Message ("'");
+                        end case;
                      end;
                   when 'l' =>
                      --  Location
@@ -512,7 +341,6 @@ package body Errorout is
                         Arg_Line : Natural;
                         Arg_Col : Natural;
                      begin
-                        pragma Assert (not Progname);
                         case Arg.Kind is
                            when Earg_Location =>
                               Arg_Loc := Arg.Val_Loc;
@@ -527,14 +355,15 @@ package body Errorout is
                         --  Do not print the filename if in the same file as
                         --  the error location.
                         if Arg_File = File then
-                           Put ("line ");
+                           Report_Handler.Message ("line ");
                         else
-                           Put (Name_Table.Image (Get_File_Name (Arg_File)));
-                           Put (':');
+                           Report_Handler.Message
+                             (Name_Table.Image (Get_File_Name (Arg_File)));
+                           Report_Handler.Message (":");
                         end if;
-                        Disp_Natural (Arg_Line);
-                        Put (':');
-                        Disp_Natural (Arg_Col);
+                        Report_Handler.Message (Natural_Image (Arg_Line));
+                        Report_Handler.Message (":");
+                        Report_Handler.Message (Natural_Image (Arg_Col));
                      end;
                   when 'n' =>
                      --  Node
@@ -543,7 +372,7 @@ package body Errorout is
                      begin
                         case Arg.Kind is
                            when Earg_Iir =>
-                              Put (Disp_Node (Arg.Val_Iir));
+                              Report_Handler.Message (Disp_Node (Arg.Val_Iir));
                            when others =>
                               --  Invalid conversion to node.
                               raise Internal_Error;
@@ -554,16 +383,17 @@ package body Errorout is
                      declare
                         Arg : Earg_Type renames Args (Argn);
                      begin
-                        Put ('"');
+                        Report_Handler.Message ("""");
                         case Arg.Kind is
                            when Earg_String8 =>
-                              Put (Str_Table.String_String8
-                                     (Arg.Val_Str8.Str, Arg.Val_Str8.Len));
+                              Report_Handler.Message
+                                (Str_Table.String_String8
+                                   (Arg.Val_Str8.Str, Arg.Val_Str8.Len));
                            when others =>
                               --  Invalid conversion to character.
                               raise Internal_Error;
                         end case;
-                        Put ('"');
+                        Report_Handler.Message ("""");
                      end;
                   when others =>
                      --  Unknown format.
@@ -573,32 +403,13 @@ package body Errorout is
             end if;
             N := N + 1;
          end loop;
-         Put (Msg (First .. N - 1));
+         Report_Handler.Message (Msg (First .. N - 1));
 
          --  Are all arguments displayed ?
          pragma Assert (Argn > Args'Last);
       end;
 
-      if Flag_Diagnostics_Show_Option
-        and then Id in Msgid_Warnings
-      then
-         Put (" [-W");
-         Put (Warning_Image (Id));
-         Put ("]");
-      end if;
-
-      if Flag_Color_Diagnostics = On then
-         Set_Color (Color_None);
-      end if;
-
-      Put_Line;
-
-      if Flag_Caret_Diagnostics
-        and then (File /= No_Source_File_Entry and Line /= 0)
-      then
-         Put_Line (Extract_Expanded_Line (File, Line));
-         Put_Line ((1 .. Col - 1 => ' ') & '^');
-      end if;
+      Report_Handler.Message_End.all;
    end Report_Msg;
 
    procedure Error_Msg_Option_NR (Msg: String) is
@@ -797,10 +608,11 @@ package body Errorout is
    -- Disp a bug message.
    procedure Error_Internal (Expr: in Iir; Msg: String := "")
    is
+      use Ada.Text_IO;
       pragma Unreferenced (Expr);
    begin
-      Put ("internal error: ");
-      Put_Line (Msg);
+      Put (Standard_Error, "internal error: ");
+      Put_Line (Standard_Error, Msg);
       raise Internal_Error;
    end Error_Internal;
 
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index a6cf848a0..b0b7e53ad 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -23,10 +23,6 @@ package Errorout is
    Option_Error: exception;
    Compilation_Error: exception;
 
-   --  Set the program name, used in error messages for options.  Not displayed
-   --  if not initialized.
-   procedure Set_Program_Name (Name : String);
-
    -- This kind can't be handled.
    --procedure Error_Kind (Msg: String; Kind: Iir_Kind);
    procedure Error_Kind (Msg: String; An_Iir: in Iir);
@@ -178,6 +174,27 @@ package Errorout is
    type Report_Origin is
      (Option, Library, Scan, Parse, Semantic, Elaboration);
 
+   type Error_Record is record
+      Origin : Report_Origin;
+      File : Source_File_Entry;
+      Line : Natural;
+      Offset : Natural;
+      Id : Msgid_Type;
+      Cont : Boolean;
+   end record;
+
+   type Error_Start_Handler is access procedure (Err : Error_Record);
+   type Message_Handler is access procedure (Str : String);
+   type Message_End_Handler is access procedure;
+
+   type Report_Msg_Handler is record
+      Error_Start : Error_Start_Handler;
+      Message : Message_Handler;
+      Message_End : Message_End_Handler;
+   end record;
+
+   procedure Set_Report_Handler (Handler : Report_Msg_Handler);
+
    --  Generic report message.  LOC maybe No_Location.
    --  If ORIGIN is Option or Library, LOC must be No_Location and the program
    --  name is displayed.
@@ -357,4 +374,10 @@ private
         | Warnid_Pure | Warnid_Specs | Warnid_Hide
         | Warnid_Port    => (Enabled => True, Error => False),
       others             => (Enabled => False, Error => False));
+
+   --  Compute the column from Error_Record E.
+   function Get_Error_Col (E : Error_Record) return Natural;
+
+   --  Image of VAL, without the leading space.
+   function Natural_Image (Val: Natural) return String;
 end Errorout;
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index 1a5637e21..5d94fd470 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -243,31 +243,15 @@ package body Scanner is
       return Current_Context.Line_Number;
    end Get_Current_Line;
 
-   function Get_Current_Column return Natural
-   is
-      Col : Natural;
-      Name : Name_Id;
+   function Get_Current_Offset return Natural is
    begin
-      Coord_To_Position
-        (Current_Context.Source_File,
-         Current_Context.Line_Pos,
-         Integer (Current_Context.Pos - Current_Context.Line_Pos),
-         Name, Col);
-      return Col;
-   end Get_Current_Column;
-
-   function Get_Token_Column return Natural
-   is
-      Col : Natural;
-      Name : Name_Id;
+      return Natural (Current_Context.Pos - Current_Context.Line_Pos);
+   end Get_Current_Offset;
+
+   function Get_Token_Offset return Natural is
    begin
-      Coord_To_Position
-        (Current_Context.Source_File,
-         Current_Context.Line_Pos,
-         Integer (Current_Context.Token_Pos - Current_Context.Line_Pos),
-         Name, Col);
-      return Col;
-   end Get_Token_Column;
+      return Natural (Current_Context.Token_Pos - Current_Context.Line_Pos);
+   end Get_Token_Offset;
 
    function Get_Token_Position return Source_Ptr is
    begin
diff --git a/src/vhdl/scanner.ads b/src/vhdl/scanner.ads
index 5ed6f04db..176904cab 100644
--- a/src/vhdl/scanner.ads
+++ b/src/vhdl/scanner.ads
@@ -111,14 +111,15 @@ package Scanner is
    --  False (used by PSL).
    function Scan_Underscore return Boolean;
 
-   -- Get the current location, or the location of the current token.
-   -- Since a token cannot spread over lines, file and line of the current
-   -- token are the same as those of the current position.
+   --  Get the current location, or the location of the current token.
+   --  Since a token cannot spread over lines, file and line of the current
+   --  token are the same as those of the current position.
+   --  The offset is the offset in the current line.
    function Get_Current_Source_File return Source_File_Entry;
    function Get_Current_Line return Natural;
-   function Get_Current_Column return Natural;
+   function Get_Current_Offset return Natural;
    function Get_Token_Location return Location_Type;
-   function Get_Token_Column return Natural;
+   function Get_Token_Offset return Natural;
    function Get_Token_Position return Source_Ptr;
    function Get_Position return Source_Ptr;
 
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index d7dee0015..1eb8a3cd8 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -27,6 +27,7 @@ with Translation;
 with Sem;
 with Sem_Lib; use Sem_Lib;
 with Errorout; use Errorout;
+with Errorout.Console;
 with GNAT.OS_Lib;
 with Bug;
 with Trans_Be;
@@ -73,6 +74,9 @@ package body Ortho_Front is
 
    procedure Init is
    begin
+      --  Set program name for error message.
+      Errorout.Console.Install_Handler;
+
       -- Initialize.
       Trans_Be.Register_Translation_Back_End;