-- 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, see <gnu.org/licenses>.
with Simple_IO; use Simple_IO;
with Utils_IO; use Utils_IO;
with Vhdl.Nodes; use Vhdl.Nodes;
package body Elab.Vhdl_Values.Debug is
procedure Put_Dir (Dir : Direction_Type) is
begin
case Dir is
when Dir_To =>
Put ("to");
when Dir_Downto =>
Put ("downto");
end case;
end Put_Dir;
procedure Debug_Bound (Bnd : Bound_Type; Verbose : Boolean) is
begin
Put_Int32 (Bnd.Left);
Put (' ');
Put_Dir (Bnd.Dir);
Put (' ');
Put_Int32 (Bnd.Right);
if Verbose then
Put (" [l=");
Put_Uns32 (Bnd.Len);
Put (']');
end if;
end Debug_Bound;
procedure Debug_Typ_Phys (T : Type_Acc) is
begin
Put ("[al=");
Put_Int32 (Int32 (T.Al));
Put (" sz=");
Put_Uns32 (Uns32 (T.Sz));
Put (" w=");
Put_Uns32 (T.W);
Put (']');
end Debug_Typ_Phys;
procedure Debug_Typ1 (T : Type_Acc) is
begin
case T.Kind is
when Type_Bit =>
Put ("bit");
Debug_Typ_Phys (T);
when Type_Logic =>
Put ("bit/logic");
Debug_Typ_Phys (T);
when Type_Vector =>
Put ("vector ");
Debug_Typ_Phys (T);
Put (" (");
Debug_Bound (T.Abound, True);
Put (") of ");
Debug_Typ1 (T.Arr_El);
when Type_Array =>
Put ("arr ");
Debug_Typ_Phys (T);
Put (" (");
declare
It : Type_Acc;
begin
It := T;
loop
Debug_Bound (It.Abound, True);
exit when It.Alast;
Put (", ");
It := It.Arr_El;
end loop;
Put (") of ");
Debug_Typ1 (It.Arr_El);
end;
when Type_Record =>
Put ("rec ");
Debug_Typ_Phys (T);
Put (" (");
for I in T.Rec.E'Range loop
if I /= 1 then
Put (", ");
end if;
Put ("[noff=");
Put_Uns32 (T.Rec.E (I).Offs.Net_Off);
Put (", moff=");
Put_Uns32 (Uns32 (T.Rec.E (I).Offs.Mem_Off));
Put ("] ");
Debug_Typ1 (T.Rec.E (I).Typ);
end loop;
Put (")");
when Type_Unbounded_Record =>
Put ("unbounded record");
when Type_Discrete =>
Put ("discrete ");
Debug_Typ_Phys (T);
Put (": ");
Put_Int64 (T.Drange.Left);
Put (' ');
Put_Dir (T.Drange.Dir);
Put (' ');
Put_Int64 (T.Drange.Right);
if T.Drange.Is_Signed then
Put (" [signed]");
else
Put (" [unsigned]");
end if;
when Type_Access =>
Put ("access");
when Type_File =>
Put ("file");
when Type_Float =>
Put ("float");
when Type_Slice =>
Put ("slice");
when Type_Unbounded_Vector =>
Put ("unbounded vector");
when Type_Unbounded_Array =>
Put ("unbounded arr (");
declare
It : Type_Acc;
begin
It := T;
loop
Put ("<>");
exit when It.Ulast;
Put (", ");
It := It.Uarr_El;
end loop;
Put (") of ");
Debug_Typ1 (It.Uarr_El);
end;
when Type_Protected =>
Put ("protected");
end case;
end Debug_Typ1;
procedure Debug_Typ (T : Type_Acc) is
begin
Debug_Typ1 (T);
New_Line;
end Debug_Typ;
procedure Debug_Type_Short (T : Type_Acc) is
begin
case T.Kind is
when Type_Bit =>
Put ("bit");
when Type_Logic =>
Put ("logic");
when Type_Vector =>
Debug_Type_Short (T.Arr_El);
Put ("_vec(");
Debug_Bound (T.Abound, False);
Put (")");
when Type_Array =>
declare
It : Type_Acc;
begin
Put ("arr (");
It := T;
loop
Debug_Bound (It.Abound, False);
exit when It.Alast;
It := It.Arr_El;
Put (", ");
end loop;
Put (")");
end;
when Type_Record =>
Put ("rec: (");
Put (")");
when Type_Unbounded_Record =>
Put ("unbounded record");
when Type_Discrete =>
Put ("discrete");
when Type_Access =>
Put ("access");
when Type_File =>
Put ("file");
when Type_Float =>
Put ("float");
when Type_Slice =>
Put ("slice");
when Type_Unbounded_Vector =>
Put ("unbounded vector");
when Type_Unbounded_Array =>
Put ("unbounded array");
when Type_Protected =>
Put ("protected");
end case;
end Debug_Type_Short;
procedure Debug_Memtyp (M : Memtyp) is
begin
case M.Typ.Kind is
when Type_Bit
| Type_Logic =>
Put ("bit/logic: ");
Put_Uns32 (Uns32 (Read_U8 (M.Mem)));
when Type_Vector =>
Put ("vector (");
Debug_Bound (M.Typ.Abound, True);
Put ("): ");
for I in 1 .. M.Typ.Abound.Len loop
Put_Uns32 (Uns32 (Read_U8 (M.Mem + Size_Type (I - 1))));
end loop;
when Type_Array =>
declare
T : Type_Acc;
El : Type_Acc;
Len : Uns32;
begin
Put ("arr (");
T := M.Typ;
Len := 1;
loop
Debug_Bound (T.Abound, True);
Len := Len * T.Abound.Len;
El := T.Arr_El;
exit when T.Alast;
T := El;
Put (", ");
end loop;
Put ("): ");
for I in 1 .. Len loop
if I > 1 then
Put (", ");
end if;
Debug_Memtyp ((El, M.Mem + Size_Type (I - 1) * El.Sz));
end loop;
end;
when Type_Record =>
Put ("rec: (");
for I in M.Typ.Rec.E'Range loop
if I > 1 then
Put (", ");
end if;
Debug_Memtyp
((M.Typ.Rec.E (I).Typ, M.Mem + M.Typ.Rec.E (I).Offs.Mem_Off));
end loop;
Put (")");
when Type_Discrete =>
Put ("discrete: ");
Put_Int64 (Read_Discrete (M));
when Type_Access =>
Put ("access");
when Type_File =>
Put ("file");
when Type_Float =>
Put ("float");
when Type_Slice =>
Put ("slice");
when Type_Unbounded_Vector =>
Put ("unbounded vector");
when Type_Unbounded_Array =>
Put ("unbounded array");
when Type_Unbounded_Record =>
Put ("unbounded record");
when Type_Protected =>
Put ("protected");
end case;
New_Line;
end Debug_Memtyp;
procedure Debug_Valtyp (V : Valtyp) is
begin
case V.Val.Kind is
when Value_Memory
| Value_Const =>
Debug_Memtyp (Get_Memtyp (V));
when Value_Net =>
Put ("net ");
Put_Uns32 (V.Val.N);
Put (' ');
Debug_Typ1 (V.Typ);
New_Line;
when Value_Signal =>
Put ("signal ");
Put_Uns32 (Uns32 (V.Val.S));
Put (": ");
Debug_Typ1 (V.Typ);
New_Line;
when Value_Wire =>
Put ("wire ");
Put_Uns32 (V.Val.N);
New_Line;
when Value_File =>
Put_Line ("a file");
when Value_Alias =>
Put ("an alias: ");
Debug_Typ1 (V.Typ);
Put (" of ");
Debug_Valtyp ((V.Typ, V.Val.A_Obj));
when Value_Dyn_Alias =>
Put ("dyn alias: ");
Debug_Typ1 (V.Typ);
end case;
end Debug_Valtyp;
end Elab.Vhdl_Values.Debug;
