1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--  O C A R I N A . B A C K E N D S . V X W O R K S 6 5 3 _ 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 Ocarina.Namet; use Ocarina.Namet;
33

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.XML_Tree.Nodes;
40
with Ocarina.Backends.XML_Tree.Nutils;
41
with Ocarina.Backends.Vxworks653_Conf.Mapping;
42
with Ocarina.Backends.Utils;
43

44
package body Ocarina.Backends.Vxworks653_Conf.Hm is
45

46
   use Ocarina.ME_AADL;
47
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
48
   use Ocarina.ME_AADL.AADL_Instances.Entities;
49
   use Ocarina.Backends.XML_Tree.Nutils;
50
   use Ocarina.Backends.Vxworks653_Conf.Mapping;
51
   use Ocarina.Backends.Utils;
52

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

57
   Root_Node : Node_Id := No_Node;
58
   HM_Node   : Node_Id := No_Node;
59

60
   procedure Visit_Architecture_Instance (E : Node_Id);
61
   procedure Visit_Component_Instance (E : Node_Id);
62
   procedure Visit_System_Instance (E : Node_Id);
63
   procedure Visit_Process_Instance (E : Node_Id);
64
   procedure Visit_Processor_Instance (E : Node_Id);
65
   procedure Visit_Bus_Instance (E : Node_Id);
66
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
67
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
68

69
   procedure Add_System_Error
70
     (XML_Node    : Node_Id;
71
      Identifier  : String;
72
      Description : String);
73

74
   procedure Add_Error_Action
75
     (XML_Node   : Node_Id;
76
      Identifier : String;
77
      Action     : String);
78

79
   pragma Unreferenced (Add_System_Error);
80

81
   function Generate_Partition_HM_Table
82
     (Virtual_Processor : Node_Id) return Node_Id;
83

84
   -----------
85
   -- Visit --
86
   -----------
87

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

94 1
         when K_Component_Instance =>
95 1
            Visit_Component_Instance (E);
96

97 0
         when others =>
98 0
            null;
99
      end case;
100 1
   end Visit;
101

102
   ---------------------------------
103
   -- Visit_Architecture_Instance --
104
   ---------------------------------
105

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

112
   ------------------------------
113
   -- Visit_Component_Instance --
114
   ------------------------------
115

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

123 0
         when CC_Process =>
124 0
            Visit_Process_Instance (E);
125

126 1
         when CC_Processor =>
127 1
            Visit_Processor_Instance (E);
128

129 0
         when CC_Bus =>
130 0
            Visit_Bus_Instance (E);
131

132 0
         when CC_Virtual_Processor =>
133 0
            Visit_Virtual_Processor_Instance (E);
134

135 0
         when others =>
136 0
            null;
137
      end case;
138 1
   end Visit_Component_Instance;
139

140
   ----------------------------
141
   -- Visit_Process_Instance --
142
   ----------------------------
143

144 0
   procedure Visit_Process_Instance (E : Node_Id) is
145
   begin
146 0
      Visit_Subcomponents_Of (E);
147 0
   end Visit_Process_Instance;
148

149
   ---------------------------
150
   -- Visit_System_Instance --
151
   ---------------------------
152

153 1
   procedure Visit_System_Instance (E : Node_Id) is
154 1
      S : Node_Id;
155
   begin
156 1
      if not AINU.Is_Empty (Subcomponents (E)) then
157 1
         S := First_Node (Subcomponents (E));
158 1
         while Present (S) loop
159
            --  Visit processor subcomponents
160

161 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
162 1
               Visit (Corresponding_Instance (S));
163
            end if;
164 1
            S := Next_Node (S);
165 1
         end loop;
166
      end if;
167 1
   end Visit_System_Instance;
168

169
   ------------------------
170
   -- Visit_Bus_Instance --
171
   ------------------------
172

173 0
   procedure Visit_Bus_Instance (E : Node_Id) is
174
      pragma Unreferenced (E);
175
   begin
176 0
      null;
177 0
   end Visit_Bus_Instance;
178

179
   ------------------------
180
   --  Add_System_Error  --
181
   ------------------------
182

183 0
   procedure Add_System_Error
184
     (XML_Node    : Node_Id;
185
      Identifier  : String;
186
      Description : String)
187
   is
188 0
      Intermediate : Node_Id;
189
   begin
190 0
      Intermediate := Make_XML_Node ("SystemError");
191 0
      XTU.Add_Attribute ("ErrorIdentifier", Identifier, Intermediate);
192 0
      XTU.Add_Attribute ("Description", Description, Intermediate);
193 0
      Append_Node_To_List (Intermediate, XTN.Subitems (XML_Node));
194 0
   end Add_System_Error;
195

196
   ------------------------
197
   --  Add_Error_Action  --
198
   ------------------------
199

200
   procedure Add_Error_Action
201
     (XML_Node   : Node_Id;
202
      Identifier : String;
203
      Action     : String)
204
   is
205 1
      Intermediate : Node_Id;
206
   begin
207 1
      Intermediate := Make_XML_Node ("ErrorIDAction");
208 1
      XTU.Add_Attribute ("ErrorIdentifier", Identifier, Intermediate);
209 1
      XTU.Add_Attribute ("ErrorAction", Action, Intermediate);
210 1
      Append_Node_To_List (Intermediate, XTN.Subitems (XML_Node));
211 1
   end Add_Error_Action;
212

213
   ------------------------------
214
   -- Visit_Processor_Instance --
215
   ------------------------------
216

217 1
   procedure Visit_Processor_Instance (E : Node_Id) is
218 1
      S                    : Node_Id;
219 1
      U                    : Node_Id;
220 1
      P                    : Node_Id;
221 1
      System_HM_Table_Node : Node_Id;
222 1
      Module_HM_Table_Node : Node_Id;
223 1
      System_State_Node    : Node_Id;
224 1
      Error_Id_Level_Node  : Node_Id;
225 1
      Settings_Node        : Node_Id;
226
   begin
227 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
228 1
      P := XTN.Node (Backend_Node (Identifier (E)));
229

230 1
      Push_Entity (P);
231 1
      Push_Entity (U);
232

233 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
234

235
      --
236
      --  For now, just generate the default HM policy.
237
      --
238

239 1
      HM_Node := Make_XML_Node ("HealthMonitor");
240 1
      Append_Node_To_List (HM_Node, XTN.Subitems (Current_XML_Node));
241

242
      --  Building the SystemHMTable first.
243

244 1
      System_HM_Table_Node := Make_XML_Node ("SystemHMTable");
245 1
      XTU.Add_Attribute ("Name", "systemHm", System_HM_Table_Node);
246 1
      Append_Node_To_List (System_HM_Table_Node, XTN.Subitems (HM_Node));
247

248 1
      System_State_Node := Make_XML_Node ("SystemState");
249 1
      XTU.Add_Attribute
250
        ("SystemState",
251
         "HM_PARTITION_MODE",
252
         System_State_Node);
253 1
      Append_Node_To_List
254
        (System_State_Node,
255 1
         XTN.Subitems (System_HM_Table_Node));
256

257 1
      Error_Id_Level_Node := Make_XML_Node ("ErrorIDLevel");
258 1
      XTU.Add_Attribute
259
        ("ErrorIdentifier",
260
         "HME_DEFAULT",
261
         Error_Id_Level_Node);
262 1
      XTU.Add_Attribute
263
        ("ErrorLevel",
264
         "HM_PARTITION_LVL",
265
         Error_Id_Level_Node);
266

267 1
      Append_Node_To_List
268
        (Error_Id_Level_Node,
269 1
         XTN.Subitems (System_State_Node));
270

271 1
      System_State_Node := Make_XML_Node ("SystemState");
272 1
      XTU.Add_Attribute ("SystemState", "HM_MODULE_MODE", System_State_Node);
273 1
      Append_Node_To_List
274
        (System_State_Node,
275 1
         XTN.Subitems (System_HM_Table_Node));
276

277 1
      Error_Id_Level_Node := Make_XML_Node ("ErrorIDLevel");
278 1
      XTU.Add_Attribute
279
        ("ErrorIdentifier",
280
         "HME_DEFAULT",
281
         Error_Id_Level_Node);
282 1
      XTU.Add_Attribute ("ErrorLevel", "HM_MODULE_LVL", Error_Id_Level_Node);
283 1
      Append_Node_To_List
284
        (Error_Id_Level_Node,
285 1
         XTN.Subitems (System_State_Node));
286

287 1
      System_State_Node := Make_XML_Node ("SystemState");
288 1
      XTU.Add_Attribute ("SystemState", "HM_PROCESS_MODE", System_State_Node);
289 1
      Append_Node_To_List
290
        (System_State_Node,
291 1
         XTN.Subitems (System_HM_Table_Node));
292

293 1
      Error_Id_Level_Node := Make_XML_Node ("ErrorIDLevel");
294 1
      XTU.Add_Attribute
295
        ("ErrorIdentifier",
296
         "HME_DEFAULT",
297
         Error_Id_Level_Node);
298 1
      XTU.Add_Attribute ("ErrorLevel", "HM_PROCESS_LVL", Error_Id_Level_Node);
299 1
      Append_Node_To_List
300
        (Error_Id_Level_Node,
301 1
         XTN.Subitems (System_State_Node));
302

303
      --  Building the ModuleHMTable then.
304

305 1
      Module_HM_Table_Node := Make_XML_Node ("ModuleHMTable");
306 1
      XTU.Add_Attribute ("Name", "moduleHm", Module_HM_Table_Node);
307 1
      Append_Node_To_List (Module_HM_Table_Node, XTN.Subitems (HM_Node));
308

309 1
      System_State_Node := Make_XML_Node ("SystemState");
310 1
      Append_Node_To_List
311
        (System_State_Node,
312 1
         XTN.Subitems (Module_HM_Table_Node));
313 1
      Add_Error_Action (System_State_Node, "HME_UNKNOWN", "hmDefaultHandler");
314 1
      Add_Error_Action (System_State_Node, "HME_NUMERIC_ERROR", "");
315 1
      Add_Error_Action
316
        (System_State_Node,
317
         "HME_POWER_FAIL",
318
         "hmDH_HME_POWER_FAIL");
319 1
      Add_Error_Action (System_State_Node, "HME_KERNEL", "hmDH_HME_KERNEL");
320 1
      Add_Error_Action
321
        (System_State_Node,
322
         "HME_CONFIG_ERROR",
323
         "hmDH_EventLog");
324 1
      Add_Error_Action
325
        (System_State_Node,
326
         "HME_INIT_ERROR",
327
         "hmDH_HME_INIT_ERROR");
328 1
      Add_Error_Action
329
        (System_State_Node,
330
         "HME_PARTITION_OVERFLOW",
331
         "hmDefaultHandler");
332 1
      Add_Error_Action
333
        (System_State_Node,
334
         "HME_PARTITION_MODE_SET",
335
         "hmDH_HME_PARTITION_MODE_SET");
336 1
      Add_Error_Action
337
        (System_State_Node,
338
         "HME_APEX_INTERNAL_ERROR",
339
         "hmDefaultHandler");
340 1
      Add_Error_Action
341
        (System_State_Node,
342
         "HME_HM_INTERNAL_ERROR",
343
         "hmDefaultHandler");
344 1
      Add_Error_Action
345
        (System_State_Node,
346
         "HME_PORT_INTERNAL_ERROR",
347
         "hmDefaultHandler");
348 1
      Add_Error_Action
349
        (System_State_Node,
350
         "HME_LOST_TICKS",
351
         "hmDH_HME_LOST_TICKS");
352 1
      Add_Error_Action (System_State_Node, "HME_HM_ERROR", "hmDefaultHandler");
353 1
      Add_Error_Action
354
        (System_State_Node,
355
         "HME_HMQ_OVERFLOW",
356
         "hmDefaultHandler");
357 1
      Add_Error_Action (System_State_Node, "HME_DATA_LOSS", "");
358 1
      Add_Error_Action
359
        (System_State_Node,
360
         "HME_HM_DEADLINE_MISSED",
361
         "hmDefaultHandler");
362 1
      Add_Error_Action (System_State_Node, "HM_MSG", "hmDH_EventLog");
363 1
      Add_Error_Action (System_State_Node, "HME_DEFAULT", "hmDefaultHandler");
364

365 1
      if not AINU.Is_Empty (Subcomponents (E)) then
366 1
         S := First_Node (Subcomponents (E));
367 1
         while Present (S) loop
368
            --  Visit virtual processor subcomponents
369

370 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
371 1
               Append_Node_To_List
372 1
                 (Generate_Partition_HM_Table (Corresponding_Instance (S)),
373 1
                  XTN.Subitems (HM_Node));
374
            end if;
375 1
            S := Next_Node (S);
376 1
         end loop;
377
      end if;
378

379 1
      Settings_Node := Make_XML_Node ("Settings");
380 1
      XTU.Add_Attribute ("maxQueueDepth", "34", Settings_Node);
381 1
      XTU.Add_Attribute ("queueThreshold", "32", Settings_Node);
382 1
      XTU.Add_Attribute ("stackSize", "16384", Settings_Node);
383 1
      XTU.Add_Attribute ("maxLogEntries", "100", Settings_Node);
384 1
      XTU.Add_Attribute ("logEntriesThreshold", "98", Settings_Node);
385 1
      XTU.Add_Attribute ("attributeMask", "0x00000001", Settings_Node);
386 1
      XTU.Add_Attribute ("notificationHandler", "", Settings_Node);
387 1
      XTU.Add_Attribute ("notifMaxQueueDepth", "0", Settings_Node);
388 1
      XTU.Add_Attribute ("eventFilterMask", "0x00000000", Settings_Node);
389 1
      XTU.Add_Attribute ("maxErrorHandlerQueueDepth", "0", Settings_Node);
390 1
      XTU.Add_Attribute ("errorHandlerQueueThreshold", "0", Settings_Node);
391 1
      Append_Node_To_List (Settings_Node, XTN.Subitems (Module_HM_Table_Node));
392

393 1
      Pop_Entity;
394 1
      Pop_Entity;
395 1
   end Visit_Processor_Instance;
396

397
   --------------------------------------
398
   -- Visit_Virtual_Processor_Instance --
399
   --------------------------------------
400

401 0
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
402 0
      S : Node_Id;
403
   begin
404 0
      if not AINU.Is_Empty (Subcomponents (E)) then
405 0
         S := First_Node (Subcomponents (E));
406 0
         while Present (S) loop
407

408 0
            Visit (Corresponding_Instance (S));
409 0
            S := Next_Node (S);
410 0
         end loop;
411
      end if;
412 0
   end Visit_Virtual_Processor_Instance;
413

414
   ---------------------------------
415
   -- Generate_Partition_HM_Table --
416
   ---------------------------------
417

418 1
   function Generate_Partition_HM_Table
419
     (Virtual_Processor : Node_Id) return Node_Id
420
   is
421 1
      Partition_HM_Table_Node : Node_Id;
422 1
      System_State_Node       : Node_Id;
423 1
      Settings_Node           : Node_Id;
424 1
      Trusted_Partition_Node  : Node_Id;
425
   begin
426 1
      Partition_HM_Table_Node := Make_XML_Node ("PartitionHMTable");
427 1
      XTU.Add_Attribute
428
        ("Name",
429
         Get_Name_String (Map_Partition_Name (Virtual_Processor)) & "_hmtable",
430
         Partition_HM_Table_Node);
431

432 1
      System_State_Node := Make_XML_Node ("SystemState");
433 1
      Append_Node_To_List
434
        (System_State_Node,
435 1
         XTN.Subitems (Partition_HM_Table_Node));
436 1
      Add_Error_Action (System_State_Node, "HME_UNKNOWN", "hmDefaultHandler");
437 1
      Add_Error_Action (System_State_Node, "HME_NUMERIC_ERROR", "");
438 1
      Add_Error_Action
439
        (System_State_Node,
440
         "HME_POWER_FAIL",
441
         "hmDH_HME_POWER_FAIL");
442 1
      Add_Error_Action (System_State_Node, "HME_KERNEL", "hmDH_HME_KERNEL");
443 1
      Add_Error_Action
444
        (System_State_Node,
445
         "HME_CONFIG_ERROR",
446
         "hmDH_EventLog");
447 1
      Add_Error_Action
448
        (System_State_Node,
449
         "HME_INIT_ERROR",
450
         "hmDH_HME_INIT_ERROR");
451 1
      Add_Error_Action
452
        (System_State_Node,
453
         "HME_PARTITION_OVERFLOW",
454
         "hmDefaultHandler");
455 1
      Add_Error_Action
456
        (System_State_Node,
457
         "HME_PARTITION_MODE_SET",
458
         "hmDH_HME_PARTITION_MODE_SET");
459 1
      Add_Error_Action
460
        (System_State_Node,
461
         "HME_APEX_INTERNAL_ERROR",
462
         "hmDefaultHandler");
463 1
      Add_Error_Action
464
        (System_State_Node,
465
         "HME_HM_INTERNAL_ERROR",
466
         "hmDefaultHandler");
467 1
      Add_Error_Action
468
        (System_State_Node,
469
         "HME_PORT_INTERNAL_ERROR",
470
         "hmDefaultHandler");
471 1
      Add_Error_Action
472
        (System_State_Node,
473
         "HME_LOST_TICKS",
474
         "hmDH_HME_LOST_TICKS");
475 1
      Add_Error_Action (System_State_Node, "HME_HM_ERROR", "hmDefaultHandler");
476 1
      Add_Error_Action
477
        (System_State_Node,
478
         "HME_HMQ_OVERFLOW",
479
         "hmDefaultHandler");
480 1
      Add_Error_Action (System_State_Node, "HME_DATA_LOSS", "");
481 1
      Add_Error_Action
482
        (System_State_Node,
483
         "HME_HM_DEADLINE_MISSED",
484
         "hmDefaultHandler");
485 1
      Add_Error_Action (System_State_Node, "HM_MSG", "hmDH_EventLog");
486 1
      Add_Error_Action (System_State_Node, "HME_DEFAULT", "hmDefaultHandler");
487

488 1
      Settings_Node := Make_XML_Node ("Settings");
489 1
      XTU.Add_Attribute ("maxQueueDepth", "34", Settings_Node);
490 1
      XTU.Add_Attribute ("queueThreshold", "32", Settings_Node);
491 1
      XTU.Add_Attribute ("stackSize", "16384", Settings_Node);
492 1
      XTU.Add_Attribute ("maxLogEntries", "100", Settings_Node);
493 1
      XTU.Add_Attribute ("logEntriesThreshold", "98", Settings_Node);
494 1
      XTU.Add_Attribute ("attributeMask", "0x00000001", Settings_Node);
495 1
      XTU.Add_Attribute ("notificationHandler", "", Settings_Node);
496 1
      XTU.Add_Attribute ("notifMaxQueueDepth", "0", Settings_Node);
497 1
      XTU.Add_Attribute ("eventFilterMask", "0xFFFFFFFF", Settings_Node);
498 1
      XTU.Add_Attribute ("maxErrorHandlerQueueDepth", "128", Settings_Node);
499 1
      XTU.Add_Attribute ("errorHandlerQueueThreshold", "126", Settings_Node);
500 1
      Append_Node_To_List
501
        (Settings_Node,
502 1
         XTN.Subitems (Partition_HM_Table_Node));
503

504 1
      Trusted_Partition_Node := Make_XML_Node ("TrustedPartition");
505 1
      XTU.Add_Attribute
506
        ("NameRef",
507 1
         Get_Name_String (Map_Partition_Name (Virtual_Processor)),
508
         Trusted_Partition_Node);
509 1
      Append_Node_To_List
510
        (Trusted_Partition_Node,
511 1
         XTN.Subitems (Settings_Node));
512

513 1
      return Partition_HM_Table_Node;
514
   end Generate_Partition_HM_Table;
515

516
end Ocarina.Backends.Vxworks653_Conf.Hm;

Read our documentation on viewing source code .

Loading