OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--        O C A R I N A . B A C K E N D S . D E O S _ C O N F . H M         --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2015-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 Ada.Strings;       use Ada.Strings;
33
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
34

35
--  with Locations;
36

37
with Ocarina.ME_AADL;
38
with Ocarina.ME_AADL.AADL_Instances.Nodes;
39
with Ocarina.ME_AADL.AADL_Instances.Nutils;
40
with Ocarina.ME_AADL.AADL_Instances.Entities;
41

42
--  with Ocarina.Backends.Properties;
43
with Ocarina.Backends.XML_Tree.Nodes;
44
with Ocarina.Backends.XML_Tree.Nutils;
45
--  with Ocarina.Backends.Deos_Conf.Mapping;
46

47
package body Ocarina.Backends.Deos_Conf.Hm is
48

49
--   use Locations;
50
   use Ocarina.ME_AADL;
51
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
52
   use Ocarina.ME_AADL.AADL_Instances.Entities;
53
   use Ocarina.Backends.XML_Tree.Nutils;
54
--   use Ocarina.Backends.Properties;
55
--   use Ocarina.Backends.Deos_Conf.Mapping;
56

57
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
58
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
59
   package XTU renames Ocarina.Backends.XML_Tree.Nutils;
60

61
   Root_Node : Node_Id := No_Node;
62
   HM_Node   : Node_Id := No_Node;
63

64
   procedure Visit_Architecture_Instance (E : Node_Id);
65
   procedure Visit_Component_Instance (E : Node_Id);
66
   procedure Visit_System_Instance (E : Node_Id);
67
   procedure Visit_Process_Instance (E : Node_Id);
68
   procedure Visit_Processor_Instance (E : Node_Id);
69
   procedure Visit_Bus_Instance (E : Node_Id);
70
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
71

72
   procedure Add_System_Error
73
     (XML_Node    : Node_Id;
74
      Identifier  : String;
75
      Description : String);
76

77
   procedure Add_Error_Action
78
     (XML_Node   : Node_Id;
79
      Identifier : String;
80
      Level      : String;
81
      Action     : String);
82
   -----------
83
   -- Visit --
84
   -----------
85

86 1
   procedure Visit (E : Node_Id) is
87
   begin
88 1
      case Kind (E) is
89 1
         when K_Architecture_Instance =>
90 1
            Visit_Architecture_Instance (E);
91

92 1
         when K_Component_Instance =>
93 1
            Visit_Component_Instance (E);
94

95 0
         when others =>
96 0
            null;
97 1
      end case;
98 1
   end Visit;
99

100
   ---------------------------------
101
   -- Visit_Architecture_Instance --
102
   ---------------------------------
103

104 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
105
   begin
106 1
      Root_Node := Root_System (E);
107 1
      Visit (Root_Node);
108 1
   end Visit_Architecture_Instance;
109

110
   ------------------------------
111
   -- Visit_Component_Instance --
112
   ------------------------------
113

114 1
   procedure Visit_Component_Instance (E : Node_Id) is
115 1
      Category : constant Component_Category := Get_Category_Of_Component (E);
116
   begin
117 1
      case Category is
118 1
         when CC_System =>
119 1
            Visit_System_Instance (E);
120

121 0
         when CC_Process =>
122 0
            Visit_Process_Instance (E);
123

124 1
         when CC_Processor =>
125 1
            Visit_Processor_Instance (E);
126

127 0
         when CC_Bus =>
128 0
            Visit_Bus_Instance (E);
129

130 1
         when CC_Virtual_Processor =>
131 1
            Visit_Virtual_Processor_Instance (E);
132

133 0
         when others =>
134 0
            null;
135 1
      end case;
136 1
   end Visit_Component_Instance;
137

138
   ----------------------------
139
   -- Visit_Process_Instance --
140
   ----------------------------
141

142 0
   procedure Visit_Process_Instance (E : Node_Id) is
143 0
      S : Node_Id;
144
   begin
145 0
      if not AINU.Is_Empty (Subcomponents (E)) then
146 0
         S := First_Node (Subcomponents (E));
147 0
         while Present (S) loop
148
            --  Visit the component instance corresponding to the
149
            --  subcomponent S.
150

151 0
            Visit (Corresponding_Instance (S));
152 0
            S := Next_Node (S);
153 0
         end loop;
154
      end if;
155 0
   end Visit_Process_Instance;
156

157
   ---------------------------
158
   -- Visit_System_Instance --
159
   ---------------------------
160

161 1
   procedure Visit_System_Instance (E : Node_Id) is
162 1
      S : Node_Id;
163
   begin
164 1
      if not AINU.Is_Empty (Subcomponents (E)) then
165 1
         S := First_Node (Subcomponents (E));
166 1
         while Present (S) loop
167
            --  Visit the component instance corresponding to the
168
            --  subcomponent S.
169 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
170 1
               Visit (Corresponding_Instance (S));
171
            end if;
172 1
            S := Next_Node (S);
173 1
         end loop;
174
      end if;
175 1
   end Visit_System_Instance;
176

177
   ------------------------
178
   -- Visit_Bus_Instance --
179
   ------------------------
180

181 0
   procedure Visit_Bus_Instance (E : Node_Id) is
182
      pragma Unreferenced (E);
183
   begin
184 0
      null;
185 0
   end Visit_Bus_Instance;
186

187
   ------------------------
188
   --  Add_System_Error  --
189
   ------------------------
190

191 1
   procedure Add_System_Error
192
     (XML_Node    : Node_Id;
193
      Identifier  : String;
194
      Description : String)
195
   is
196 1
      Intermediate : Node_Id;
197
   begin
198 1
      Intermediate := Make_XML_Node ("SystemError");
199 1
      XTU.Add_Attribute ("ErrorIdentifier", Identifier, Intermediate);
200 1
      XTU.Add_Attribute ("Description", Description, Intermediate);
201 1
      Append_Node_To_List (Intermediate, XTN.Subitems (XML_Node));
202 1
   end Add_System_Error;
203

204
   ------------------------
205
   --  Add_Error_Action  --
206
   ------------------------
207

208 1
   procedure Add_Error_Action
209
     (XML_Node   : Node_Id;
210
      Identifier : String;
211
      Level      : String;
212
      Action     : String)
213
   is
214 1
      Intermediate : Node_Id;
215
   begin
216 1
      Intermediate := Make_XML_Node ("ErrorAction");
217 1
      XTU.Add_Attribute ("ErrorIdentifierRef", Identifier, Intermediate);
218 1
      XTU.Add_Attribute ("ErrorLevel", Level, Intermediate);
219 1
      XTU.Add_Attribute ("ModuleRecoveryAction", Action, Intermediate);
220 1
      Append_Node_To_List (Intermediate, XTN.Subitems (XML_Node));
221 1
   end Add_Error_Action;
222

223
   ------------------------------
224
   -- Visit_Processor_Instance --
225
   ------------------------------
226

227 1
   procedure Visit_Processor_Instance (E : Node_Id) is
228 1
      S                    : Node_Id;
229 1
      U                    : Node_Id;
230 1
      P                    : Node_Id;
231 1
      System_Errors        : Node_Id;
232 1
      Multi_Partition_HM   : Node_Id;
233 1
      Partition_HM         : Node_Id;
234 1
      Partition_Identifier : Unsigned_Long_Long;
235
   begin
236 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
237 1
      P := XTN.Node (Backend_Node (Identifier (E)));
238

239 1
      Push_Entity (P);
240 1
      Push_Entity (U);
241

242 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
243

244 1
      Partition_Identifier := 1;
245

246
      --
247
      --  For now, just generate the default HM policy.
248
      --
249

250 1
      HM_Node := Make_XML_Node ("HealthMonitoring");
251

252 1
      Append_Node_To_List (HM_Node, XTN.Subitems (Current_XML_Node));
253

254 1
      System_Errors := Make_XML_Node ("SystemErrors");
255

256 1
      Append_Node_To_List (System_Errors, XTN.Subitems (HM_Node));
257 1
      Add_System_Error (System_Errors, "1", "processorSpecific");
258 1
      Add_System_Error (System_Errors, "2", "floatingPoint");
259 1
      Add_System_Error (System_Errors, "3", "accessViolation");
260 1
      Add_System_Error (System_Errors, "4", "powerTransient");
261 1
      Add_System_Error (System_Errors, "5", "platformSpecific");
262 1
      Add_System_Error (System_Errors, "6", "frameResync");
263 1
      Add_System_Error (System_Errors, "7", "deadlineMissed");
264 1
      Add_System_Error (System_Errors, "8", "applicationError");
265 1
      Add_System_Error (System_Errors, "9", "illegalRequest");
266 1
      Add_System_Error (System_Errors, "10", "stackOverflow");
267

268
      --
269
      --  The MultiPartitionHM
270
      --
271

272 1
      Multi_Partition_HM := Make_XML_Node ("MultiPartitionHM");
273 1
      XTU.Add_Attribute ("TableIdentifier", "1", Multi_Partition_HM);
274 1
      XTU.Add_Attribute
275
        ("TableName",
276
         "default MultiPartitionHM",
277
         Multi_Partition_HM);
278 1
      Append_Node_To_List (Multi_Partition_HM, XTN.Subitems (HM_Node));
279 1
      Add_Error_Action (Multi_Partition_HM, "1", "MODULE", "IGNORE");
280 1
      Add_Error_Action (Multi_Partition_HM, "2", "MODULE", "IGNORE");
281 1
      Add_Error_Action (Multi_Partition_HM, "3", "MODULE", "IGNORE");
282 1
      Add_Error_Action (Multi_Partition_HM, "4", "MODULE", "IGNORE");
283 1
      Add_Error_Action (Multi_Partition_HM, "5", "MODULE", "IGNORE");
284 1
      Add_Error_Action (Multi_Partition_HM, "6", "MODULE", "IGNORE");
285 1
      Add_Error_Action (Multi_Partition_HM, "7", "MODULE", "IGNORE");
286 1
      Add_Error_Action (Multi_Partition_HM, "8", "MODULE", "IGNORE");
287 1
      Add_Error_Action (Multi_Partition_HM, "9", "MODULE", "IGNORE");
288 1
      Add_Error_Action (Multi_Partition_HM, "10", "MODULE", "IGNORE");
289

290 1
      if not AINU.Is_Empty (Subcomponents (E)) then
291 1
         S := First_Node (Subcomponents (E));
292 1
         while Present (S) loop
293
            --  Visit the component instance corresponding to the
294
            --  subcomponent S.
295

296 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
297 1
               Visit (Corresponding_Instance (S));
298
               --
299
               --  The PartitionHM
300
               --
301

302 1
               Partition_HM := Make_XML_Node ("PartitionHM");
303 1
               Append_Node_To_List (Partition_HM, XTN.Subitems (HM_Node));
304

305 1
               XTU.Add_Attribute
306
                 ("TableIdentifier",
307 1
                  Trim (Unsigned_Long_Long'Image (Partition_Identifier), Left),
308
                  Partition_HM);
309

310 1
               XTU.Add_Attribute
311
                 ("TableName",
312 1
                  "Unique name for partition " &
313 1
                  Trim (Unsigned_Long_Long'Image (Partition_Identifier), Left),
314
                  Partition_HM);
315 1
               XTU.Add_Attribute
316
                 ("MultiPartitionHMTableNameRef",
317
                  "default MultiPartitionHM",
318
                  Partition_HM);
319 1
               Partition_Identifier := Partition_Identifier + 1;
320
            end if;
321 1
            S := Next_Node (S);
322 1
         end loop;
323
      end if;
324

325 1
      Pop_Entity;
326 1
      Pop_Entity;
327 1
   end Visit_Processor_Instance;
328

329
   --------------------------------------
330
   -- Visit_Virtual_Processor_Instance --
331
   --------------------------------------
332

333 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
334 1
      S : Node_Id;
335
   begin
336 1
      if not AINU.Is_Empty (Subcomponents (E)) then
337 0
         S := First_Node (Subcomponents (E));
338 0
         while Present (S) loop
339

340 0
            Visit (Corresponding_Instance (S));
341 0
            S := Next_Node (S);
342 0
         end loop;
343
      end if;
344 1
   end Visit_Virtual_Processor_Instance;
345

346
end Ocarina.Backends.Deos_Conf.Hm;

Read our documentation on viewing source code .

Loading