Add errorout-memory.

7 files changed, 183 insertions, 15 deletions

diff --git a/src/vhdl/errorout-console.adb b/src/vhdl/errorout-console.adb
index 194b80ea4..cbb2b1bd5 100644
--- a/src/vhdl/errorout-console.adb
+++ b/src/vhdl/errorout-console.adb
@@ -267,8 +267,8 @@ package body Errorout.Console is
 
    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));
+      Set_Report_Handler ((Console_Error_Start'Access,
+                           Console_Message'Access,
+                           Console_Message_End'Access));
    end Install_Handler;
 end Errorout.Console;
diff --git a/src/vhdl/errorout-memory.adb b/src/vhdl/errorout-memory.adb
new file mode 100644
index 000000000..a1a8d672a
--- /dev/null
+++ b/src/vhdl/errorout-memory.adb
@@ -0,0 +1,102 @@
+--  Store error messages
+--  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 Tables;
+
+package body Errorout.Memory is
+
+   type Char_Index is new Uns32;
+
+   package Messages is new Tables
+     (Table_Component_Type => Character,
+      Table_Index_Type => Char_Index,
+      Table_Low_Bound => 1,
+      Table_Initial => 128);
+
+   type Error_Element is record
+      Header : Error_Record;
+      Str : Char_Index;
+   end record;
+
+   package Errors is new Tables
+     (Table_Component_Type => Error_Element,
+      Table_Index_Type => Error_Index,
+      Table_Low_Bound => 1,
+      Table_Initial => 32);
+
+   function Get_Nbr_Messages return Error_Index is
+   begin
+      return Errors.Last;
+   end Get_Nbr_Messages;
+
+   function Get_Error_Record (Idx : Error_Index) return Error_Record is
+   begin
+      return Errors.Table (Idx).Header;
+   end Get_Error_Record;
+
+   function Get_Error_Message (Idx : Error_Index) return String
+   is
+      First : constant Char_Index := Errors.Table (Idx).Str;
+      Last : Char_Index;
+   begin
+      if Idx = Errors.Last then
+         Last := Messages.Last;
+      else
+         Last := Errors.Table (Idx + 1).Str - 1;
+      end if;
+      return String (Messages.Table (First .. Last - 1));
+   end Get_Error_Message;
+
+   function Get_Error_Message_Addr (Idx : Error_Index) return System.Address
+   is
+      First : constant Char_Index := Errors.Table (Idx).Str;
+   begin
+      return Messages.Table (First)'Address;
+   end Get_Error_Message_Addr;
+
+   procedure Clear_Errors is
+   begin
+      Errors.Init;
+      Messages.Init;
+   end Clear_Errors;
+
+   procedure Memory_Error_Start (E : Error_Record) is
+   begin
+      Errors.Append ((E, Messages.Last + 1));
+   end Memory_Error_Start;
+
+   procedure Memory_Message (Str : String) is
+   begin
+      for I in Str'Range loop
+         Messages.Append (Str (I));
+      end loop;
+   end Memory_Message;
+
+   procedure Memory_Message_End is
+   begin
+      Messages.Append (ASCII.NUL);
+   end Memory_Message_End;
+
+   procedure Install_Handler is
+   begin
+      Set_Report_Handler ((Memory_Error_Start'Access,
+                           Memory_Message'Access,
+                           Memory_Message_End'Access));
+   end Install_Handler;
+
+end Errorout.Memory;
diff --git a/src/vhdl/errorout-memory.ads b/src/vhdl/errorout-memory.ads
new file mode 100644
index 000000000..4c638671e
--- /dev/null
+++ b/src/vhdl/errorout-memory.ads
@@ -0,0 +1,38 @@
+--  Store error messages
+--  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 System;
+
+package Errorout.Memory is
+   type Error_Index is new Uns32;
+
+   --  Get number of messages available.
+   function Get_Nbr_Messages return Error_Index;
+
+   --  Get messages.
+   --  Idx is from 1 to Nbr_Messages.
+   function Get_Error_Record (Idx : Error_Index) return Error_Record;
+   function Get_Error_Message (Idx : Error_Index) return String;
+   function Get_Error_Message_Addr (Idx : Error_Index) return System.Address;
+
+   --  Remove all error messages.
+   procedure Clear_Errors;
+
+   --  Install the handlers for reporting errors.
+   procedure Install_Handler;
+end Errorout.Memory;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 64b0d8d0b..e31bf4477 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -253,7 +253,7 @@ package body Errorout is
       end case;
 
       Report_Handler.Error_Start
-        (Err => (Origin, File, Line, Offset, Id, Cont));
+        (Err => (Origin, Id, Cont, File, Line, Offset));
 
       --  Display message.
       declare
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index b0b7e53ad..eb9c2a7a3 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -176,11 +176,11 @@ package Errorout is
 
    type Error_Record is record
       Origin : Report_Origin;
+      Id : Msgid_Type;
+      Cont : Boolean;
       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);
diff --git a/src/vhdl/python/libghdl.adb b/src/vhdl/python/libghdl.adb
index ac038c25b..0267ccec7 100644
--- a/src/vhdl/python/libghdl.adb
+++ b/src/vhdl/python/libghdl.adb
@@ -19,6 +19,8 @@
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 with Ghdllocal;
 with Ghdlcomp;
+with Errorout.Memory;
+pragma Unreferenced (Errorout.Memory);  --  At least from Ada code.
 
 package body Libghdl is
    function Set_Option (Opt : Thin_String_Ptr; Len : Natural) return Integer is
diff --git a/src/vhdl/python/libghdl/thin.py b/src/vhdl/python/libghdl/thin.py
index b5c0c497e..25e03809c 100644
--- a/src/vhdl/python/libghdl/thin.py
+++ b/src/vhdl/python/libghdl/thin.py
@@ -1,5 +1,5 @@
 from libghdl import libghdl
-from ctypes import (c_char_p, c_int32, c_int, c_bool, sizeof, c_void_p,
+from ctypes import (c_char_p, c_int32, c_int, c_int8, c_bool, sizeof, c_void_p,
                     POINTER, Structure)
 import libghdl.iirs as iirs
 import libghdl.nodes_meta as nodes_meta
@@ -26,8 +26,15 @@ def analyze_file(filename):
     return _analyze_file(c_char_p(filename), len(filename))
 
 
-# Lists
+Null_Iir = 0
+Null_Iir_List = 0
+Iir_List_All = 1
 
+Null_Iir_Flist = 0
+Iir_Flist_Others = 1
+Iir_Flist_All = 2
+
+# Lists
 
 class Lists:
     List_Type = c_int32
@@ -156,7 +163,7 @@ class Scanner:
 
     Get_Current_Line = libghdl.scanner__get_current_line
 
-    Get_Token_Column = libghdl.scanner__get_token_column
+    Get_Token_Offset = libghdl.scanner__get_token_offset
 
     Get_Token_Position = libghdl.scanner__get_token_position
 
@@ -231,10 +238,29 @@ class Iirs_Utils:
     Get_Interface_Of_Formal = \
         libghdl.iirs_utils__get_interface_of_formal
 
-Null_Iir = 0
-Null_Iir_List = 0
-Iir_List_All = 1
+# Errorout
 
-Null_Iir_Flist = 0
-Iir_Flist_Others = 1
-Iir_Flist_All = 2
+class Errorout:
+    class Error_Record(Structure):
+        _fields_ = [("origin", c_int8),
+                    ("id", c_int8),
+                    ("cont", c_int8),
+                    ("file", c_int32),
+                    ("line", c_int32),
+                    ("offset", c_int32)]
+
+
+class Errorout_Memory:
+    Install_Handler = libghdl.errorout__memory__install_handler
+
+    Get_Nbr_Messages = libghdl.errorout__memory__get_nbr_messages
+
+    Get_Error_Record = libghdl.errorout__memory__get_error_record
+    Get_Error_Record.argstypes = [c_int32]
+    Get_Error_Record.restype = Errorout.Error_Record
+
+    Get_Error_Message = libghdl.errorout__memory__get_error_message_addr
+    Get_Error_Message.argstype = [c_int32]
+    Get_Error_Message.restype = c_char_p
+
+    Clear_Errors = libghdl.errorout__memory__clear_errors