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

32
with Charset;                           use Charset;
33
with Locations;                         use Locations;
34
with Ocarina.Namet;                     use Ocarina.Namet;
35
with Utils;                             use Utils;
36
with Ocarina.Backends.ASN1_Tree.Nutils; use Ocarina.Backends.ASN1_Tree.Nutils;
37
with Ocarina.Backends.ASN1_Values;      use Ocarina.Backends.ASN1_Values;
38

39
package body Ocarina.Backends.ASN1_Tree.Debug is
40

41
   -----------
42
   -- Image --
43
   -----------
44

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

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

66 0
   function Image (N : Node_Id) return String is
67
   begin
68 0
      return Image (Int (N));
69 0
   end Image;
70

71 0
   function Image (N : Value_Id) return String is
72
   begin
73 0
      return ASN1_Values.Image (N);
74 0
   end Image;
75

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

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

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

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

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

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

114
   ------------
115
   -- W_Byte --
116
   ------------
117

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

123
   ---------------
124
   -- W_Indents --
125
   ---------------
126

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

134
   ---------------
135
   -- W_List_Id --
136
   ---------------
137

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

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

152
   ----------------------
153
   -- W_Node_Attribute --
154
   ----------------------
155

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

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

176 0
      if K = "Name_Id" then
177 0
         Write_Line (Quoted (V));
178 0
      elsif K = "Node_Id" and then Present (C) then
179 0
         case Kind (C) is
180
            when others =>
181 0
               Write_Line (V);
182
         end case;
183
      else
184 0
         Write_Line (V);
185
      end if;
186

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

201 0
      N_Indents := N_Indents - 1;
202
   end W_Node_Attribute;
203

204
   -------------------
205
   -- W_Node_Header --
206
   -------------------
207

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

218
   ---------------
219
   -- W_Node_Id --
220
   ---------------
221

222 0
   procedure W_Node_Id (N : Node_Id) is
223
   begin
224 0
      if N = No_Node then
225 0
         return;
226
      end if;
227

228 0
      W_Node (N);
229
   end W_Node_Id;
230

231
end Ocarina.Backends.ASN1_Tree.Debug;

Read our documentation on viewing source code .

Loading