1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                OCARINA.BACKENDS.ARINC653_CONF.SYSTEM_HM                  --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                  Copyright (C) 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 Locations;
34
with Ocarina.ME_AADL;
35
with Ocarina.ME_AADL.AADL_Instances.Nodes;
36
with Ocarina.ME_AADL.AADL_Instances.Nutils;
37
with Ocarina.ME_AADL.AADL_Instances.Entities;
38

39
with Ocarina.Backends.Properties;
40
with Ocarina.Backends.XML_Tree.Nodes;
41
with Ocarina.Backends.XML_Tree.Nutils;
42
with Ocarina.Backends.ARINC653_Conf.Mapping;
43

44
package body Ocarina.Backends.ARINC653_Conf.System_HM is
45

46
   use Locations;
47
   use Ocarina.ME_AADL;
48
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
49
   use Ocarina.ME_AADL.AADL_Instances.Entities;
50
   use Ocarina.Backends.XML_Tree.Nutils;
51
   use Ocarina.Backends.Properties;
52
   use Ocarina.Backends.ARINC653_Conf.Mapping;
53

54
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
55
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
56
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
57
   package XTU renames Ocarina.Backends.XML_Tree.Nutils;
58

59
   procedure Visit_Architecture_Instance (E : Node_Id);
60
   procedure Visit_Component_Instance (E : Node_Id);
61
   procedure Visit_System_Instance (E : Node_Id);
62
   procedure Visit_Process_Instance (E : Node_Id);
63
   procedure Visit_Processor_Instance (E : Node_Id);
64
   procedure Visit_Bus_Instance (E : Node_Id);
65
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
66

67
   -----------
68
   -- Visit --
69
   -----------
70

71 0
   procedure Visit (E : Node_Id) is
72
   begin
73 0
      case Kind (E) is
74 0
         when K_Architecture_Instance =>
75 0
            Visit_Architecture_Instance (E);
76

77 0
         when K_Component_Instance =>
78 0
            Visit_Component_Instance (E);
79

80 0
         when others =>
81 0
            null;
82 0
      end case;
83 0
   end Visit;
84

85
   ---------------------------------
86
   -- Visit_Architecture_Instance --
87
   ---------------------------------
88

89 0
   procedure Visit_Architecture_Instance (E : Node_Id) is
90
   begin
91 0
      Visit (Root_System (E));
92 0
   end Visit_Architecture_Instance;
93

94
   ------------------------------
95
   -- Visit_Component_Instance --
96
   ------------------------------
97

98 0
   procedure Visit_Component_Instance (E : Node_Id) is
99 0
      Category : constant Component_Category := Get_Category_Of_Component (E);
100
   begin
101 0
      case Category is
102 0
         when CC_System =>
103 0
            Visit_System_Instance (E);
104

105 0
         when CC_Process =>
106 0
            Visit_Process_Instance (E);
107

108 0
         when CC_Processor =>
109 0
            Visit_Processor_Instance (E);
110

111 0
         when CC_Bus =>
112 0
            Visit_Bus_Instance (E);
113

114 0
         when CC_Virtual_Processor =>
115 0
            Visit_Virtual_Processor_Instance (E);
116

117 0
         when others =>
118 0
            null;
119 0
      end case;
120 0
   end Visit_Component_Instance;
121

122
   ----------------------------
123
   -- Visit_Process_Instance --
124
   ----------------------------
125

126 0
   procedure Visit_Process_Instance (E : Node_Id) is
127 0
      S : Node_Id;
128
   begin
129 0
      if not AINU.Is_Empty (Subcomponents (E)) then
130 0
         S := First_Node (Subcomponents (E));
131 0
         while Present (S) loop
132
            --  Visit the component instance corresponding to the
133
            --  subcomponent S.
134

135 0
            Visit (Corresponding_Instance (S));
136 0
            S := Next_Node (S);
137 0
         end loop;
138
      end if;
139 0
   end Visit_Process_Instance;
140

141
   ---------------------------
142
   -- Visit_System_Instance --
143
   ---------------------------
144

145 0
   procedure Visit_System_Instance (E : Node_Id) is
146 0
      S : Node_Id;
147
   begin
148 0
      if not AINU.Is_Empty (Subcomponents (E)) then
149 0
         S := First_Node (Subcomponents (E));
150 0
         while Present (S) loop
151
            --  Visit the component instance corresponding to the
152
            --  subcomponent S.
153 0
            if AINU.Is_Processor (Corresponding_Instance (S)) then
154 0
               Visit (Corresponding_Instance (S));
155
            end if;
156 0
            S := Next_Node (S);
157 0
         end loop;
158
      end if;
159 0
   end Visit_System_Instance;
160

161
   ------------------------
162
   -- Visit_Bus_Instance --
163
   ------------------------
164

165 0
   procedure Visit_Bus_Instance (E : Node_Id) is
166
      pragma Unreferenced (E);
167
   begin
168 0
      null;
169 0
   end Visit_Bus_Instance;
170

171
   ------------------------------
172
   -- Visit_Processor_Instance --
173
   ------------------------------
174

175 0
   procedure Visit_Processor_Instance (E : Node_Id) is
176 0
      S : Node_Id;
177 0
      U : Node_Id;
178 0
      P : Node_Id;
179
   begin
180 0
      U := XTN.Unit (Backend_Node (Identifier (E)));
181 0
      P := XTN.Node (Backend_Node (Identifier (E)));
182

183 0
      Push_Entity (P);
184 0
      Push_Entity (U);
185

186 0
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
187

188 0
      Append_Node_To_List
189 0
        (Map_System_HM_Table (E),
190 0
         XTN.Subitems (Current_XML_Node));
191

192 0
      if not AINU.Is_Empty (Subcomponents (E)) then
193 0
         S := First_Node (Subcomponents (E));
194 0
         while Present (S) loop
195
            --  Visit the component instance corresponding to the
196
            --  subcomponent S.
197

198 0
            Visit (Corresponding_Instance (S));
199 0
            S := Next_Node (S);
200 0
         end loop;
201
      end if;
202

203 0
      Pop_Entity;
204 0
      Pop_Entity;
205 0
   end Visit_Processor_Instance;
206

207
   --------------------------------------
208
   -- Visit_Virtual_Processor_Instance --
209
   --------------------------------------
210

211 0
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
212 0
      S : Node_Id;
213
   begin
214 0
      if not AINU.Is_Empty (Subcomponents (E)) then
215 0
         S := First_Node (Subcomponents (E));
216 0
         while Present (S) loop
217
            --  Visit the component instance corresponding to the
218
            --  subcomponent S.
219

220 0
            Visit (Corresponding_Instance (S));
221 0
            S := Next_Node (S);
222 0
         end loop;
223
      end if;
224 0
   end Visit_Virtual_Processor_Instance;
225

226
   ------------------
227
   --  First_Pass  --
228
   ------------------
229

230
   package body First_Pass is
231

232
      procedure Visit_Component (E : Node_Id);
233
      procedure Visit_System (E : Node_Id);
234
      procedure Visit_Process (E : Node_Id);
235
      procedure Visit_Processor (E : Node_Id);
236
      procedure Visit_Virtual_Processor (E : Node_Id);
237

238
      -----------
239
      -- Visit --
240
      -----------
241

242 0
      procedure Visit (E : Node_Id) is
243
      begin
244 0
         case Kind (E) is
245 0
            when K_Architecture_Instance =>
246 0
               Visit (Root_System (E));
247

248 0
            when K_Component_Instance =>
249 0
               Visit_Component (E);
250

251 0
            when others =>
252 0
               null;
253 0
         end case;
254 0
      end Visit;
255

256
      ---------------------
257
      -- Visit_Component --
258
      ---------------------
259

260 0
      procedure Visit_Component (E : Node_Id) is
261
         Category : constant Component_Category :=
262 0
           Get_Category_Of_Component (E);
263
      begin
264 0
         case Category is
265 0
            when CC_System =>
266 0
               Visit_System (E);
267

268 0
            when CC_Process =>
269 0
               Visit_Process (E);
270

271 0
            when CC_Device =>
272 0
               Visit_Process (E);
273

274 0
            when CC_Processor =>
275 0
               Visit_Processor (E);
276

277 0
            when CC_Virtual_Processor =>
278 0
               Visit_Virtual_Processor (E);
279

280 0
            when others =>
281 0
               null;
282 0
         end case;
283 0
      end Visit_Component;
284

285
      -------------------
286
      -- Visit_Process --
287
      -------------------
288

289 0
      procedure Visit_Process (E : Node_Id) is
290 0
         N              : Node_Id;
291 0
         Processes_List : List_Id;
292
      begin
293
         Processes_List :=
294 0
           XTN.Processes (Backend_Node (Identifier (Get_Bound_Processor (E))));
295

296 0
         N := XTU.Make_Container (E);
297

298 0
         XTU.Append_Node_To_List (N, Processes_List);
299 0
      end Visit_Process;
300

301
      --------------------------------------
302
      -- Visit_Virtual_Processor_Instance --
303
      --------------------------------------
304

305 0
      procedure Visit_Virtual_Processor (E : Node_Id) is
306 0
         Processes : List_Id;
307 0
         N         : Node_Id;
308
      begin
309 0
         N := New_Node (XTN.K_HI_Tree_Bindings);
310

311 0
         AIN.Set_Backend_Node (Identifier (E), N);
312

313 0
         Processes := XTU.New_List (XTN.K_List_Id);
314

315 0
         XTN.Set_Processes (N, Processes);
316

317 0
      end Visit_Virtual_Processor;
318

319
      ---------------------
320
      -- Visit_Processor --
321
      ---------------------
322

323 0
      procedure Visit_Processor (E : Node_Id) is
324 0
         S         : Node_Id;
325 0
         P         : Node_Id;
326 0
         U         : Node_Id;
327 0
         N         : Node_Id;
328 0
         Processes : List_Id;
329
      begin
330 0
         P := Map_HI_Node (E);
331 0
         Push_Entity (P);
332

333 0
         U := Map_HI_Unit (E);
334 0
         Push_Entity (U);
335

336 0
         if not AINU.Is_Empty (Subcomponents (E)) then
337 0
            S := First_Node (Subcomponents (E));
338 0
            while Present (S) loop
339
               --  Visit the component instance corresponding to the
340
               --  subcomponent S.
341

342 0
               Visit (Corresponding_Instance (S));
343 0
               S := Next_Node (S);
344 0
            end loop;
345
         end if;
346

347 0
         N := New_Node (XTN.K_HI_Tree_Bindings);
348

349 0
         Processes := AINU.New_List (K_Node_Id, No_Location);
350

351 0
         XTN.Set_Processes (N, Processes);
352

353 0
         XTN.Set_Unit (N, U);
354 0
         XTN.Set_Node (N, P);
355

356 0
         AIN.Set_Backend_Node (Identifier (E), N);
357

358 0
         Pop_Entity;
359 0
         Pop_Entity;
360 0
      end Visit_Processor;
361

362
      ------------------
363
      -- Visit_System --
364
      ------------------
365

366 0
      procedure Visit_System (E : Node_Id) is
367 0
         S                  : Node_Id;
368 0
         Component_Instance : Node_Id;
369
      begin
370 0
         if not AINU.Is_Empty (Subcomponents (E)) then
371 0
            S := First_Node (Subcomponents (E));
372 0
            while Present (S) loop
373 0
               Component_Instance := Corresponding_Instance (S);
374 0
               if Get_Category_Of_Component (Component_Instance) =
375
                 CC_Processor
376
               then
377 0
                  Visit_Processor (Component_Instance);
378
               end if;
379 0
               S := Next_Node (S);
380 0
            end loop;
381
         end if;
382

383 0
         if not AINU.Is_Empty (Subcomponents (E)) then
384 0
            S := First_Node (Subcomponents (E));
385 0
            while Present (S) loop
386
               --  Visit the component instance corresponding to the
387
               --  subcomponent S.
388 0
               if AINU.Is_Process_Or_Device (Corresponding_Instance (S)) then
389 0
                  Visit_Process (Corresponding_Instance (S));
390
               end if;
391 0
               S := Next_Node (S);
392 0
            end loop;
393
         end if;
394

395 0
      end Visit_System;
396
   end First_Pass;
397

398
end Ocarina.Backends.ARINC653_Conf.System_HM;

Read our documentation on viewing source code .

Loading