1 files changed, 121 insertions, 0 deletions
diff --git a/src/synth/netlists-errors.adb b/src/synth/netlists-errors.adb
new file mode 100644
index 000000000..880ae1418
--- /dev/null
+++ b/src/synth/netlists-errors.adb
@@ -0,0 +1,121 @@
+--  Error handling for synthesis.
+--  Copyright (C) 2017 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program 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 of the License, or
+--  (at your option) any later version.
+--
+--  This program 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 this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+package body Netlists.Errors is
+   function "+" (N : Instance) return Earg_Type is
+   begin
+      return Make_Earg_Synth_Instance (Uns32 (N));
+   end "+";
+
+   function "+" (N : Net) return Earg_Type is
+   begin
+      return Make_Earg_Synth_Net (Uns32 (N));
+   end "+";
+
+   function "+" (N : Sname) return Earg_Type is
+   begin
+      return Make_Earg_Synth_Name (Uns32 (N));
+   end "+";
+
+   procedure Output_Name_1 (N : Sname)
+   is
+      Prefix : Sname;
+   begin
+      --  Do not crash on No_Name.
+      if N = No_Sname then
+         Output_Message ("*nil*");
+         return;
+      end if;
+
+      Prefix := Get_Sname_Prefix (N);
+      if Prefix /= No_Sname then
+         Output_Name_1 (Prefix);
+         Output_Message (".");
+      end if;
+
+      case Get_Sname_Kind (N) is
+         when Sname_User =>
+            Output_Identifier (Get_Sname_Suffix (N));
+         when Sname_Artificial =>
+            Output_Identifier (Get_Sname_Suffix (N));
+         when Sname_Version =>
+            Output_Message ("n");
+            Output_Uns32 (Get_Sname_Version (N));
+      end case;
+   end Output_Name_1;
+
+   procedure Synth_Instance_Handler
+     (Format : Character; Err : Error_Record; Val : Uns32)
+   is
+      pragma Unreferenced (Err);
+      Inst : constant Instance := Instance (Val);
+   begin
+      if Format = 'n' then
+         Output_Name_1 (Get_Name (Inst));
+      else
+         raise Internal_Error;
+      end if;
+   end Synth_Instance_Handler;
+
+   procedure Synth_Net_Handler
+     (Format : Character; Err : Error_Record; Val : Uns32)
+   is
+      pragma Unreferenced (Err);
+      N : constant Net := Net (Val);
+   begin
+      if Format = 'n' then
+         declare
+            Inst : constant Instance := Get_Net_Parent (N);
+            Idx : constant Port_Idx := Get_Port_Idx (N);
+         begin
+            if Is_Self_Instance (Inst) then
+               Output_Name_1 (Get_Input_Desc (Get_Module (Inst), Idx).Name);
+            else
+               Output_Name_1 (Get_Output_Desc (Get_Module (Inst), Idx).Name);
+            end if;
+         end;
+      else
+         raise Internal_Error;
+      end if;
+   end Synth_Net_Handler;
+
+   procedure Synth_Name_Handler
+     (Format : Character; Err : Error_Record; Val : Uns32)
+   is
+      pragma Unreferenced (Err);
+      N : constant Sname := Sname (Val);
+   begin
+      if Format = 'n' then
+         Output_Name_1 (N);
+      else
+         raise Internal_Error;
+      end if;
+   end Synth_Name_Handler;
+
+   procedure Initialize is
+   begin
+      Register_Earg_Handler
+        (Earg_Synth_Instance, Synth_Instance_Handler'Access);
+      Register_Earg_Handler
+        (Earg_Synth_Net, Synth_Net_Handler'Access);
+      Register_Earg_Handler
+        (Earg_Synth_Name, Synth_Name_Handler'Access);
+   end Initialize;
+end Netlists.Errors;