1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--        O C A R I N A . B A C K E N D S . C _ T R E E . D E B U G         --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Charset;                        use Charset;
34
with Locations;                      use Locations;
35
with Ocarina.Namet;                  use Ocarina.Namet;
36
with Utils;                          use Utils;
37
with Ocarina.Backends.C_Values;      use Ocarina.Backends.C_Values;
38
with Ocarina.Backends.C_Tree.Nutils; use Ocarina.Backends.C_Tree.Nutils;
39

40
package body Ocarina.Backends.C_Tree.Debug is
41

42
   -----------
43
   -- Image --
44
   -----------
45

46 0
   function Image (N : Node_Kind) return String is
47 0
      S : String := Node_Kind'Image (N);
48
   begin
49 0
      To_Lower (S);
50 0
      for I in S'Range loop
51 0
         if S (I) = '_' then
52 0
            S (I) := ' ';
53
         end if;
54 0
      end loop;
55 0
      return S (3 .. S'Last);
56 0
   end Image;
57

58 0
   function Image (N : Name_Id) return String is
59
   begin
60 0
      if N = No_Name then
61 0
         return No_Str;
62
      else
63 0
         return Get_Name_String (N);
64
      end if;
65 0
   end Image;
66

67 0
   function Image (N : Value_Id) return String is
68
   begin
69 0
      return C_Values.Image (N);
70 0
   end Image;
71

72 0
   function Image (N : Node_Id) return String is
73
   begin
74 0
      return Image (Int (N));
75 0
   end Image;
76

77 0
   function Image (N : List_Id) return String is
78
   begin
79 0
      return Image (Int (N));
80 0
   end Image;
81

82 0
   function Image (N : Mode_Id) return String is
83
   begin
84 0
      case N is
85 0
         when Mode_In =>
86 0
            return Quoted ("in");
87 0
         when Mode_Inout =>
88 0
            return Quoted ("in out");
89 0
         when Mode_Out =>
90 0
            return Quoted ("out");
91
      end case;
92
   end Image;
93

94 0
   function Image (N : Operator_Id) return String is
95
   begin
96 0
      return Quoted (Operator_Image (Integer (N)));
97 0
   end Image;
98

99 0
   function Image (N : Boolean) return String is
100
   begin
101 0
      return Boolean'Image (N);
102 0
   end Image;
103

104 0
   function Image (N : Byte) return String is
105
   begin
106 0
      return Image (Int (N));
107 0
   end Image;
108

109 0
   function Image (N : Int) return String is
110 0
      S : constant String := Int'Image (N);
111
   begin
112 0
      return S (S'First + 1 .. S'Last);
113 0
   end Image;
114

115
   ------------
116
   -- W_Byte --
117
   ------------
118

119 0
   procedure W_Byte (N : Byte) is
120
   begin
121 0
      Write_Int (Int (N));
122 0
   end W_Byte;
123

124
   ---------------
125
   -- W_Indents --
126
   ---------------
127

128 0
   procedure W_Indents is
129
   begin
130 0
      for I in 1 .. N_Indents loop
131 0
         Write_Str ("   ");
132 0
      end loop;
133 0
   end W_Indents;
134

135
   ---------------
136
   -- W_List_Id --
137
   ---------------
138

139 0
   procedure W_List_Id (L : List_Id) is
140 0
      N : Node_Id;
141
   begin
142 0
      if L = No_List then
143 0
         return;
144
      end if;
145

146 0
      N := First_Node (L);
147 0
      while Present (N) loop
148 0
         W_Node_Id (N);
149 0
         N := Next_Node (N);
150 0
      end loop;
151
   end W_List_Id;
152

153
   ----------------------
154
   -- W_Node_Attribute --
155
   ----------------------
156

157 0
   procedure W_Node_Attribute
158
     (A : String;
159
      K : String;
160
      V : String;
161
      N : Int := 0)
162
   is
163 0
      C : Node_Id;
164
   begin
165 0
      if A = "Next_Node" or else A = "Package_Declaration" then
166 0
         return;
167
      end if;
168

169 0
      N_Indents := N_Indents + 1;
170 0
      W_Indents;
171 0
      Write_Str (A);
172 0
      Write_Char (' ');
173 0
      Write_Str (K);
174 0
      Write_Char (' ');
175 0
      C := Node_Id (N);
176

177 0
      if K = "Name_Id" then
178 0
         Write_Line (Quoted (V));
179 0
      elsif K = "Node_Id" and then Present (C) then
180 0
         case Kind (C) is
181
            when K_Int .. K_Char =>
182 0
               Write_Line ('(' & Image (Kind (Node_Id (N))) & ')');
183
            when others =>
184 0
               Write_Line (V);
185
         end case;
186
      else
187 0
         Write_Line (V);
188
      end if;
189

190 0
      if A /= "Frontend_Node"
191 0
        and then A /= "Corresponding_Node"
192 0
        and then A /= "Parent"
193 0
        and then A /= "Distributed_Application_Unit"
194 0
        and then A /= "Distributed_Application"
195 0
        and then A /= "Partition"
196
      then
197 0
         if K = "Node_Id" then
198 0
            W_Node_Id (Node_Id (N));
199 0
         elsif K = "List_Id" then
200 0
            W_List_Id (List_Id (N));
201
         end if;
202
      end if;
203

204 0
      N_Indents := N_Indents - 1;
205
   end W_Node_Attribute;
206

207
   -------------------
208
   -- W_Node_Header --
209
   -------------------
210

211 0
   procedure W_Node_Header (N : Node_Id) is
212
   begin
213 0
      W_Indents;
214 0
      Write_Int (Int (N));
215 0
      Write_Char (' ');
216 0
      Write_Str (Image (Kind (N)));
217 0
      Write_Char (' ');
218 0
      Write_Line (Image (Loc (N)));
219 0
   end W_Node_Header;
220

221
   ---------------
222
   -- W_Node_Id --
223
   ---------------
224

225 0
   procedure W_Node_Id (N : Node_Id) is
226
   begin
227 0
      if N = No_Node then
228 0
         return;
229
      end if;
230

231 0
      W_Node (N);
232
   end W_Node_Id;
233

234
end Ocarina.Backends.C_Tree.Debug;

Read our documentation on viewing source code .

Loading