OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--        O C A R I N A . B A C K E N D S . C H E D D A R . M A I N         --
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 Ocarina.ME_AADL;
33
with Ocarina.ME_AADL.AADL_Instances.Nodes;
34
with Ocarina.ME_AADL.AADL_Instances.Entities;
35
with Ocarina.Backends.XML_Tree.Nodes;
36
with Ocarina.Backends.XML_Tree.Nutils;
37
with Ocarina.Backends.Cheddar.Mapping;
38
with Ocarina.Backends.Utils;
39
with Ocarina.Backends.Helper;
40

41
package body Ocarina.Backends.Cheddar.Main is
42

43
   use Ocarina.ME_AADL;
44
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
45
   use Ocarina.ME_AADL.AADL_Instances.Entities;
46
   use Ocarina.Backends.XML_Tree.Nutils;
47
   use Ocarina.Backends.Cheddar.Mapping;
48
   use Ocarina.Backends.Utils;
49
   use Ocarina.Backends.Helper;
50

51
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
52

53
   procedure Visit_Component (E : Node_Id);
54
   procedure Visit_System (E : Node_Id);
55
   procedure Visit_Processor (E : Node_Id);
56
   procedure Visit_Thread (E : Node_Id);
57
   procedure Visit_Process (E : Node_Id);
58
   procedure Visit_Data (E : Node_Id);
59
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
60

61
   Root_System_Node  : Node_Id := No_Node;
62
   Cheddar_Node      : Node_Id := No_Node;
63
   Tasks_Node        : Node_Id := No_Node;
64
   Processors_Node   : Node_Id := No_Node;
65
   Address_Node      : Node_Id := No_Node;
66
   Buffers_Node      : Node_Id := No_Node;
67
   Resources_Node    : Node_Id := No_Node;
68
   Dependencies_Node : Node_Id := No_Node;
69

70
   -----------
71
   -- Visit --
72
   -----------
73

74 1
   procedure Visit (E : Node_Id) is
75
   begin
76 1
      case Kind (E) is
77 1
         when K_Architecture_Instance =>
78 1
            Root_System_Node := Root_System (E);
79 1
            Visit (Root_System_Node);
80

81 1
         when K_Component_Instance =>
82 1
            Visit_Component (E);
83

84 0
         when others =>
85 0
            null;
86 1
      end case;
87 1
   end Visit;
88

89
   ---------------------
90
   -- Visit_Component --
91
   ---------------------
92

93 1
   procedure Visit_Component (E : Node_Id) is
94 1
      Category : constant Component_Category := Get_Category_Of_Component (E);
95
   begin
96 1
      case Category is
97 1
         when CC_System =>
98 1
            Visit_System (E);
99

100 1
         when CC_Processor =>
101 1
            Visit_Processor (E);
102

103 1
         when CC_Process =>
104 1
            Visit_Process (E);
105

106 1
         when CC_Thread =>
107 1
            Visit_Thread (E);
108

109 1
         when CC_Data =>
110 1
            Visit_Data (E);
111

112 1
         when others =>
113 1
            null;
114 1
      end case;
115 1
   end Visit_Component;
116

117
   ------------------
118
   -- Visit_Thread --
119
   ------------------
120

121 1
   procedure Visit_Thread (E : Node_Id) is
122
   begin
123 1
      Append_Node_To_List (Map_Thread (E), XTN.Subitems (Tasks_Node));
124

125 1
      for F of Features_Of (E) loop
126 1
         if Kind (F) = K_Port_Spec_Instance and then Is_Event (F) then
127 1
            if Is_In (F) then
128 1
               Append_Node_To_List
129 1
                 (Map_Buffer (E, F),
130 1
                  XTN.Subitems (Buffers_Node));
131
            end if;
132 1
            Append_Node_To_List
133 1
              (Map_Dependency (E, F),
134 1
               XTN.Subitems (Dependencies_Node));
135
         end if;
136
      end loop;
137

138 1
      Visit_Subcomponents_Of (E);
139 1
   end Visit_Thread;
140

141
   ----------------
142
   -- Visit_Data --
143
   ----------------
144

145 1
   procedure Visit_Data (E : Node_Id) is
146
   begin
147 1
      Append_Node_To_List (Map_Data (E), XTN.Subitems (Resources_Node));
148 1
      Visit_Subcomponents_Of (E);
149 1
   end Visit_Data;
150

151
   ----------------------------
152
   -- Visit_Process_Instance --
153
   ----------------------------
154

155 1
   procedure Visit_Process (E : Node_Id) is
156
   begin
157 1
      Append_Node_To_List (Map_Process (E), XTN.Subitems (Address_Node));
158 1
      Visit_Subcomponents_Of (E);
159 1
   end Visit_Process;
160

161
   ---------------------
162
   -- Visit_Processor --
163
   ---------------------
164

165 1
   procedure Visit_Processor (E : Node_Id) is
166
   begin
167 1
      Append_Node_To_List (Map_Processor (E), XTN.Subitems (Processors_Node));
168 1
      Visit_Subcomponents_Of (E);
169 1
   end Visit_Processor;
170

171
   ------------------
172
   -- Visit_System --
173
   ------------------
174

175 1
   procedure Visit_System (E : Node_Id) is
176 1
      P : Node_Id;
177 1
      U : Node_Id;
178
   begin
179 1
      if E = Root_System_Node then
180 1
         P := Map_HI_Node (E);
181 1
         Push_Entity (P);
182

183 1
         U := Map_HI_Unit (E);
184 1
         Push_Entity (U);
185

186
         --  A cheddar XML file is made of one cheddar node, with several
187
         --  children: tasks (AADL tasks), processors (AADL processors),
188
         --  address_spaces (AADL processes), resources (AADL data
189
         --  components).
190

191
         --  <!ELEMENT cheddar (processors,
192
         --                     (address_spaces)?,
193
         --                     (tasks)?,
194
         --                     ((event_analyzers)?
195
         --                      |(networks)?
196
         --                      |(buffers)?
197
         --                      |(resources)?
198
         --                      |(messages)?),
199
         --                     (dependencies)?)
200
         --  >
201

202 1
         if Cheddar_Node = No_Node then
203 1
            Cheddar_Node := Make_XML_Node ("cheddar");
204 1
            Append_Node_To_List
205
              (Cheddar_Node,
206 1
               XTN.Subitems (XTN.Root_Node (XTN.XML_File (U))));
207
         end if;
208

209 1
         if Processors_Node = No_Node then
210 1
            Processors_Node := Make_XML_Node ("processors");
211 1
            Append_Node_To_List (Processors_Node, XTN.Subitems (Cheddar_Node));
212
         end if;
213

214 1
         if Address_Node = No_Node then
215 1
            Address_Node := Make_XML_Node ("address_spaces");
216 1
            Append_Node_To_List (Address_Node, XTN.Subitems (Cheddar_Node));
217
         end if;
218

219 1
         if Tasks_Node = No_Node then
220 1
            Tasks_Node := Make_XML_Node ("tasks");
221 1
            Append_Node_To_List (Tasks_Node, XTN.Subitems (Cheddar_Node));
222
         end if;
223

224 1
         if Buffers_Node = No_Node then
225 1
            Buffers_Node := Make_XML_Node ("buffers");
226 1
            Append_Node_To_List (Buffers_Node, XTN.Subitems (Cheddar_Node));
227
         end if;
228

229 1
         if Resources_Node = No_Node then
230 1
            Resources_Node := Make_XML_Node ("resources");
231 1
            Append_Node_To_List (Resources_Node, XTN.Subitems (Cheddar_Node));
232
         end if;
233

234 1
         if Dependencies_Node = No_Node then
235 1
            Dependencies_Node := Make_XML_Node ("dependencies");
236 1
            Append_Node_To_List
237
              (Dependencies_Node,
238 1
               XTN.Subitems (Cheddar_Node));
239
         end if;
240
      end if;
241

242 1
      Visit_Subcomponents_Of (E);
243

244 1
      if E = Root_System_Node then
245 1
         Pop_Entity;
246 1
         Pop_Entity; --  A
247
      end if;
248 1
   end Visit_System;
249

250
end Ocarina.Backends.Cheddar.Main;

Read our documentation on viewing source code .

Loading