From 9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sun, 5 Apr 2020 22:55:18 +0200
Subject: Add synth-values-debug.

---
 src/synth/synth-values-debug.adb | 91 ++++++++++++++++++++++++++++++++++++++++
 src/synth/synth-values-debug.ads | 24 +++++++++++
 src/synth/synthesis.adb          |  2 +
 3 files changed, 117 insertions(+)
 create mode 100644 src/synth/synth-values-debug.adb
 create mode 100644 src/synth/synth-values-debug.ads

diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb
new file mode 100644
index 000000000..e2d3bac45
--- /dev/null
+++ b/src/synth/synth-values-debug.adb
@@ -0,0 +1,91 @@
+--  Values in 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.
+
+with Simple_IO; use Simple_IO;
+with Utils_IO; use Utils_IO;
+
+package body Synth.Values.Debug is
+   procedure Debug_Bound (Bnd : Bound_Type) is
+   begin
+      Put_Int32 (Bnd.Left);
+      Put (' ');
+      case Bnd.Dir is
+         when Iir_To =>
+            Put ("to");
+         when Iir_Downto =>
+            Put ("downto");
+      end case;
+      Put (' ');
+      Put_Int32 (Bnd.Right);
+      Put (" [");
+      Put_Uns32 (Bnd.Len);
+      Put (']');
+   end Debug_Bound;
+
+   procedure Debug_Memtyp (M : Memory_Ptr; Typ : Type_Acc) is
+   begin
+      case Typ.Kind is
+         when Type_Vector =>
+            Put ("vector (");
+            Debug_Bound (Typ.Vbound);
+            Put ("): ");
+            for I in 1 .. Typ.Vbound.Len loop
+               Put_Uns32 (Uns32 (Read_U8 (M + Size_Type (I - 1))));
+            end loop;
+         when Type_Array =>
+            Put ("arr (");
+            for I in 1 .. Typ.Abounds.Ndim loop
+               if I > 1 then
+                  Put (", ");
+               end if;
+               Debug_Bound (Typ.Abounds.D (I));
+            end loop;
+            Put ("): ");
+            for I in 1 .. Get_Array_Flat_Length (Typ) loop
+               if I > 1 then
+                  Put (", ");
+               end if;
+               Debug_Memtyp
+                 (M + Size_Type (I - 1) * Typ.Arr_El.Sz, Typ.Arr_El);
+            end loop;
+         when Type_Record =>
+            Put ("rec: (");
+            for I in Typ.Rec.E'Range loop
+               if I > 1 then
+                  Put (", ");
+               end if;
+               Debug_Memtyp (M + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ);
+            end loop;
+            Put (")");
+         when Type_Discrete =>
+            Put ("discrete: ");
+            Put_Int64 (Read_Discrete (M, Typ));
+         when others =>
+            Put ("others");
+      end case;
+      New_Line;
+   end Debug_Memtyp;
+
+   procedure Debug_Valtyp (V : Valtyp) is
+   begin
+      Debug_Memtyp (V.Val.Mem, V.Typ);
+   end Debug_Valtyp;
+
+end Synth.Values.Debug;
diff --git a/src/synth/synth-values-debug.ads b/src/synth/synth-values-debug.ads
new file mode 100644
index 000000000..6d59c4a99
--- /dev/null
+++ b/src/synth/synth-values-debug.ads
@@ -0,0 +1,24 @@
+--  Values in 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 Synth.Values.Debug is
+   procedure Debug_Valtyp (V : Valtyp);
+   procedure Debug_Memtyp (M : Memory_Ptr; Typ : Type_Acc);
+end Synth.Values.Debug;
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index 6e7157a53..4c83f2646 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -26,6 +26,8 @@ with Synth.Insts; use Synth.Insts;
 
 with Synth.Environment.Debug;
 pragma Unreferenced (Synth.Environment.Debug);
+with Synth.Values.Debug;
+pragma Unreferenced (Synth.Values.Debug);
 
 package body Synthesis is
    procedure Synth_Design (Design : Node;
-- 
cgit v1.2.3