1--  Debug utilities for synthesis environment.
2--  Copyright (C) 2017 Tristan Gingold
3--
4--  This file is part of GHDL.
5--
6--  This program is free software; you can redistribute it and/or modify
7--  it under the terms of the GNU General Public License as published by
8--  the Free Software Foundation; either version 2 of the License, or
9--  (at your option) any later version.
10--
11--  This program is distributed in the hope that it will be useful,
12--  but WITHOUT ANY WARRANTY; without even the implied warranty of
13--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14--  GNU General Public License for more details.
15--
16--  You should have received a copy of the GNU General Public License
17--  along with this program; if not, write to the Free Software
18--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
19--  MA 02110-1301, USA.
20
21with Ada.Text_IO; use Ada.Text_IO;
22with Netlists.Dump; use Netlists.Dump;
23
24with Synth.Values.Debug; use Synth.Values.Debug;
25
26package body Synth.Environment.Debug is
27   procedure Put_Wire_Id (Wid : Wire_Id) is
28   begin
29      Put (Wire_Id'Image (Wid));
30   end Put_Wire_Id;
31
32   procedure Debug_Wire (Wid : Wire_Id)
33   is
34      W_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
35   begin
36      Put ("Wire:");
37      Put_Wire_Id (Wid);
38      Put_Line ("  kind: " & Wire_Kind'Image (W_Rec.Kind));
39      Put_Line (" decl:" & Source.Syn_Src'Image (W_Rec.Decl));
40      Put (" gate: ");
41      Dump_Net_Name (W_Rec.Gate, True);
42      New_Line;
43      Put_Line (" cur_assign:" & Seq_Assign'Image (W_Rec.Cur_Assign));
44      Put_Line (" conc_assign:" & Conc_Assign'Image(W_Rec.Final_Assign));
45   end Debug_Wire;
46
47   procedure Dump_Partial_Assign (Pasgn : Partial_Assign)
48   is
49      procedure Dump_Value (N : Net) is
50      begin
51         if N /= No_Net then
52            Dump_Net_Name (N, True);
53            Put (" := ");
54            Disp_Instance (Get_Net_Parent (N), False, 0);
55         else
56            Put ("unassigned");
57         end if;
58      end Dump_Value;
59      P : Partial_Assign;
60   begin
61      P := Pasgn;
62      while P /= No_Partial_Assign loop
63         declare
64            Pasgn : Partial_Assign_Record renames
65              Partial_Assign_Table.Table (P);
66         begin
67            Put (" off:" & Uns32'Image (Pasgn.Offset));
68            Put (", ");
69            Dump_Value (Pasgn.Value);
70            New_Line;
71            P := Pasgn.Next;
72         end;
73      end loop;
74   end Dump_Partial_Assign;
75
76   procedure Debug_Assign (Asgn : Seq_Assign)
77   is
78      Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn);
79   begin
80      Put ("Assign" & Seq_Assign'Image (Asgn));
81      Put (" Wire Id:" & Wire_Id'Image (Rec.Id));
82      Put (", prev_assign:" & Seq_Assign'Image (Rec.Prev));
83      Put (", phi:" & Phi_Id'Image (Rec.Phi));
84      Put (", chain:" & Seq_Assign'Image (Rec.Chain));
85      New_Line;
86      declare
87         W_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Rec.Id);
88      begin
89         Put_Line (" wire decl:" & Source.Syn_Src'Image (W_Rec.Decl));
90         Put (" wire gate: ");
91         Dump_Net_Name (W_Rec.Gate, True);
92         New_Line;
93      end;
94      Put_Line (" value:");
95      case Rec.Val.Is_Static is
96         when Unknown =>
97            Put_Line ("   ??? (unknown)");
98         when True =>
99            Put_Line ("   static:");
100            Debug_Memtyp (Rec.Val.Val);
101         when False =>
102            Dump_Partial_Assign (Rec.Val.Asgns);
103      end case;
104   end Debug_Assign;
105
106   procedure Debug_Phi (Id : Phi_Id)
107   is
108      Phi : Phi_Type renames Phis_Table.Table (Id);
109      Asgn : Seq_Assign;
110   begin
111      Put ("phi_id:" & Phi_Id'Image (Id) & ", nbr:" & Uns32'Image (Phi.Nbr));
112      New_Line;
113      Asgn := Phi.First;
114      while Asgn /= No_Seq_Assign loop
115         Debug_Assign (Asgn);
116         Asgn := Get_Assign_Chain (Asgn);
117      end loop;
118   end Debug_Phi;
119
120   procedure Debug_Conc_Assigns (First : Conc_Assign)
121   is
122      Asgn : Conc_Assign;
123   begin
124      Asgn := First;
125      while Asgn /= No_Conc_Assign loop
126         Put ("conc_assign" & Conc_Assign'Image (Asgn));
127         declare
128            Arec : Conc_Assign_Record renames Conc_Assign_Table.Table (Asgn);
129         begin
130            Put (" off:" & Uns32'Image (Arec.Offset));
131            Put (", width:" & Width'Image (Get_Width (Arec.Value)));
132            New_Line;
133            Put ("  value: ");
134            Disp_Instance (Get_Net_Parent (Arec.Value), False, 0);
135            Asgn := Arec.Next;
136         end;
137         New_Line;
138      end loop;
139   end Debug_Conc_Assigns;
140end Synth.Environment.Debug;
141