diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-04-05 22:55:18 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-04-06 20:10:56 +0200 |
commit | 9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767 (patch) | |
tree | 035f62afcbfcc988a0e50e4975e75028cf697ced /src/synth/synth-values-debug.adb | |
parent | 61116ef4c5c8eb1fa28e89b7fbf58bc55c8c02b2 (diff) | |
download | ghdl-9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767.tar.gz ghdl-9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767.tar.bz2 ghdl-9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767.zip |
Add synth-values-debug.
Diffstat (limited to 'src/synth/synth-values-debug.adb')
-rw-r--r-- | src/synth/synth-values-debug.adb | 91 |
1 files changed, 91 insertions, 0 deletions
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; |