1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--            O C A R I N A . B A C K E N D S . P N . 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

38
package body Ocarina.Backends.PN.Debug is
39

40
   -----------
41
   -- Image --
42
   -----------
43

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

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

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

70 0
   function Image (N : List_Id) return String is
71
   begin
72 0
      return Image (Int (N));
73 0
   end Image;
74

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

80 0
   function Image (N : Boolean) return String is
81
   begin
82 0
      return Boolean'Image (N);
83 0
   end Image;
84

85 0
   function Image (N : Byte) return String is
86
   begin
87 0
      return Image (Int (N));
88 0
   end Image;
89

90 1
   function Image (N : Int) return String is
91 1
      S : constant String := Int'Image (N);
92
   begin
93 1
      return S (S'First + 1 .. S'Last);
94
   end Image;
95

96
   ---------------
97
   -- W_Boolean --
98
   ---------------
99

100 0
   procedure W_Boolean (N : Boolean) is
101
   begin
102 0
      Write_Str (N'Img);
103 0
   end W_Boolean;
104

105
   ------------
106
   -- W_Byte --
107
   ------------
108

109 0
   procedure W_Byte (N : Byte) is
110
   begin
111 0
      Write_Int (Int (N));
112 0
   end W_Byte;
113

114
   -----------------
115
   -- W_Full_Tree --
116
   -----------------
117

118 0
   procedure W_Full_Tree (N : Node_Id) is
119 0
      D : Node_Id := First_Node (List_Id (N));
120
   begin
121 0
      N_Indents := 0;
122 0
      while Present (D) loop
123 0
         W_Node_Id (D);
124 0
         D := Next_Node (D);
125 0
      end loop;
126 0
   end W_Full_Tree;
127

128
   ---------------
129
   -- W_Indents --
130
   ---------------
131

132 0
   procedure W_Indents is
133
   begin
134 0
      for I in 1 .. N_Indents loop
135 0
         Write_Str (" ");
136 0
      end loop;
137 0
   end W_Indents;
138

139
   ---------------
140
   -- W_List_Id --
141
   ---------------
142

143 0
   procedure W_List_Id (L : List_Id) is
144 0
      E : Node_Id;
145
   begin
146 0
      if L = No_List then
147 0
         return;
148
      end if;
149

150 0
      E := First_Node (L);
151 0
      while E /= No_Node loop
152 0
         W_Node_Id (E);
153 0
         E := Next_Node (E);
154 0
      end loop;
155
   end W_List_Id;
156

157
   ----------------------
158
   -- W_Node_Attribute --
159
   ----------------------
160

161 0
   procedure W_Node_Attribute
162
     (A : String;
163
      K : String;
164
      V : String;
165
      N : Int := 0)
166
   is
167
   begin
168
      --  Node attributes that must be ignored
169

170 0
      if A = "Next_Node" then
171 0
         return;
172
      end if;
173

174 0
      N_Indents := N_Indents + 1;
175 0
      W_Indents;
176 0
      Write_Str (A);
177 0
      Write_Char (' ');
178 0
      Write_Str (K);
179 0
      Write_Char (' ');
180

181 0
      if K = "Name_Id" then
182 0
         Write_Line (Quoted (V));
183
      else
184 0
         Write_Line (V);
185
      end if;
186

187
      --  Node attributes that must be developed
188

189 0
      if A /= "Node" then
190 0
         if K = "Node_Id" then
191 0
            W_Node_Id (Node_Id (N));
192 0
         elsif K = "List_Id" then
193 0
            W_List_Id (List_Id (N));
194
         end if;
195
      end if;
196

197 0
      N_Indents := N_Indents - 1;
198
   end W_Node_Attribute;
199

200
   -------------------
201
   -- W_Node_Header --
202
   -------------------
203

204 0
   procedure W_Node_Header (N : Node_Id) is
205
   begin
206 0
      W_Indents;
207 0
      Write_Int (Int (N));
208 0
      Write_Char (' ');
209 0
      Write_Str (Image (Kind (N)));
210 0
      Write_Char (' ');
211 0
      Write_Line (Image (Loc (N)));
212 0
   end W_Node_Header;
213

214
   ---------------
215
   -- W_Node_Id --
216
   ---------------
217

218 0
   procedure W_Node_Id (N : Node_Id) is
219
   begin
220 0
      if N = No_Node then
221 0
         return;
222
      end if;
223 0
      W_Node (N);
224
   end W_Node_Id;
225

226
end Ocarina.Backends.PN.Debug;

Read our documentation on viewing source code .

Loading