OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                  OCARINA.BACKENDS.DEOS_CONF.PARTITIONS                   --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2014-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.Integer_Text_IO;
33
with Ocarina.Backends.Messages;
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.Utils;
40
with Ocarina.Backends.Properties;
41
with Ocarina.Backends.XML_Tree.Nodes;
42
with Ocarina.Backends.XML_Tree.Nutils;
43
with Ocarina.Backends.Deos_Conf.Mapping;
44

45
package body Ocarina.Backends.Deos_Conf.Partitions is
46

47
   use Ada.Integer_Text_IO;
48
   use Ocarina.ME_AADL;
49

50
   use Ocarina.Backends.Utils;
51
   use Ocarina.Backends.Messages;
52
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
53
   use Ocarina.ME_AADL.AADL_Instances.Entities;
54
   use Ocarina.Backends.XML_Tree.Nutils;
55
   use Ocarina.Backends.Properties;
56
   use Ocarina.Backends.Deos_Conf.Mapping;
57

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

63
   Root_Node                : Node_Id            := No_Node;
64
   Partitions_Node          : Node_Id            := No_Node;
65
   Memory_Regions           : Node_Id            := No_Node;
66
   Partition_Identifier     : Integer            := 1;
67
   Process_Nb_Threads       : Unsigned_Long_Long := 0;
68
   Process_Nb_Buffers       : Unsigned_Long_Long := 0;
69
   Process_Nb_Events        : Unsigned_Long_Long := 0;
70
   Process_Nb_Lock_Objects  : Unsigned_Long_Long := 0;
71
   Process_Nb_Blackboards   : Unsigned_Long_Long := 0;
72
   Process_Blackboards_Size : Unsigned_Long_Long := 0;
73
   Process_Buffers_Size     : Unsigned_Long_Long := 0;
74

75
   procedure Visit_Architecture_Instance (E : Node_Id);
76
   procedure Visit_Component_Instance (E : Node_Id);
77
   procedure Visit_System_Instance (E : Node_Id);
78
   procedure Visit_Process_Instance (E : Node_Id);
79
   procedure Visit_Thread_Instance (E : Node_Id);
80
   procedure Visit_Processor_Instance (E : Node_Id);
81
   procedure Visit_Bus_Instance (E : Node_Id);
82
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
83
   function Find_Associated_Process
84
     (Runtime      : Node_Id;
85
      Current_Node : Node_Id := Root_Node) return Node_Id;
86
   function Find_Associated_Memory_Segment
87
     (Process      : Node_Id;
88
      Current_Node : Node_Id := Root_Node) return Node_Id;
89

90
   function Make_Default_Memory_Region return Node_Id;
91
   function Make_Memory_Region (Segment : Node_Id) return Node_Id;
92
   function Hex_Print
93
     (Num           : in Integer;
94
      Num_Of_Digits : in Positive) return String;
95

96 1
   function Hex_Print
97
     (Num           : in Integer;
98
      Num_Of_Digits : in Positive) return String
99
   is
100 1
      Temp_Str    : String (1 .. Num_Of_Digits + 5) := (others => '0');
101 1
      New_Str     : String (1 .. Num_Of_Digits)     := (others => '0');
102 1
      First_Digit : Positive;
103
   begin
104

105 1
      Put (To => Temp_Str, Item => Num, Base => 16);
106

107 1
      for I in 1 .. Num_Of_Digits + 4 loop
108 1
         if Temp_Str (I) = '#' then
109 1
            First_Digit := I + 1;
110 1
            exit;
111
         end if;
112 1
      end loop;
113

114 1
      New_Str (First_Digit - 4 .. Num_Of_Digits) :=
115 1
        Temp_Str (First_Digit .. Num_Of_Digits + 4);
116 1
      return New_Str;
117
   end Hex_Print;
118

119
   --------------------------------
120
   -- Make_Default_Memory_Region --
121
   --------------------------------
122

123 0
   function Make_Default_Memory_Region return Node_Id is
124 0
      N : Node_Id;
125
   begin
126 0
      N := Make_XML_Node ("MemoryRegion");
127

128 0
      XTU.Add_Attribute ("Name", "Initial RAM Pool", N);
129 0
      XTU.Add_Attribute ("Type", "Initial RAM Pool", N);
130 0
      XTU.Add_Attribute ("Address", "0x0", N);
131 0
      XTU.Add_Attribute ("Size", "0x19000", N);
132 0
      XTU.Add_Attribute ("AccessRights", "READ_WRITE", N);
133 0
      XTU.Add_Attribute ("PlatformMemoryPool", "0", N);
134

135 0
      return N;
136
   end Make_Default_Memory_Region;
137

138
   ------------------------
139
   -- Make_Memory_Region --
140
   ------------------------
141

142 1
   function Make_Memory_Region (Segment : Node_Id) return Node_Id is
143 1
      N : Node_Id;
144
   begin
145 1
      N := Make_XML_Node ("MemoryRegion");
146

147 1
      XTU.Add_Attribute ("Name", "Initial RAM Pool", N);
148 1
      XTU.Add_Attribute ("Type", "Initial RAM Pool", N);
149

150 1
      XTU.Add_Attribute
151
        ("Address",
152 1
         "0x" & Hex_Print (Integer (Get_Base_Address (Segment)), 8),
153
         N);
154
--      Put (Size_Str, To_Bytes
155
--                      (Get_Memory_Size (Segment)), 16);
156 1
      XTU.Add_Attribute
157
        ("Size",
158 1
         "0x" & Hex_Print (Integer (To_Bytes (Get_Memory_Size (Segment))), 8),
159
         N);
160 1
      XTU.Add_Attribute ("AccessRights", "READ_WRITE", N);
161 1
      XTU.Add_Attribute ("PlatformMemoryPool", "0", N);
162

163 1
      return N;
164
   end Make_Memory_Region;
165

166
   -----------------------------
167
   -- Find_Associated_Process --
168
   -----------------------------
169

170 1
   function Find_Associated_Process
171
     (Runtime      : Node_Id;
172
      Current_Node : Node_Id := Root_Node) return Node_Id
173
   is
174 1
      T : Node_Id;
175 1
      S : Node_Id;
176
   begin
177 1
      if Get_Category_Of_Component (Current_Node) = CC_Process
178 1
        and then Get_Bound_Processor (Current_Node) = Runtime
179
      then
180 1
         return Current_Node;
181
      end if;
182

183 1
      if not AINU.Is_Empty (Subcomponents (Current_Node)) then
184 1
         S := First_Node (Subcomponents (Current_Node));
185 1
         while Present (S) loop
186 1
            T := Find_Associated_Process (Runtime, Corresponding_Instance (S));
187

188 1
            if T /= No_Node then
189 1
               return T;
190
            end if;
191

192 1
            S := Next_Node (S);
193 1
         end loop;
194
      end if;
195

196 1
      return No_Node;
197
   end Find_Associated_Process;
198

199
   ------------------------------------
200
   -- Find_Associated_Memory_Segment --
201
   ------------------------------------
202

203 1
   function Find_Associated_Memory_Segment
204
     (Process      : Node_Id;
205
      Current_Node : Node_Id := Root_Node) return Node_Id
206
   is
207 1
      T : Node_Id;
208 1
      S : Node_Id;
209
   begin
210 1
      if Get_Category_Of_Component (Current_Node) = CC_Memory
211 1
        and then Get_Bound_Memory (Process) = Current_Node
212
      then
213 1
         return Current_Node;
214
      end if;
215

216 1
      if not AINU.Is_Empty (Subcomponents (Current_Node)) then
217 1
         S := First_Node (Subcomponents (Current_Node));
218 1
         while Present (S) loop
219
            T :=
220 1
              Find_Associated_Memory_Segment
221
                (Process,
222 1
                 Corresponding_Instance (S));
223

224 1
            if T /= No_Node then
225 1
               return T;
226
            end if;
227

228 1
            S := Next_Node (S);
229 1
         end loop;
230
      end if;
231

232 1
      return No_Node;
233
   end Find_Associated_Memory_Segment;
234

235
   -----------
236
   -- Visit --
237
   -----------
238

239 1
   procedure Visit (E : Node_Id) is
240
   begin
241 1
      case Kind (E) is
242 1
         when K_Architecture_Instance =>
243 1
            Visit_Architecture_Instance (E);
244

245 1
         when K_Component_Instance =>
246 1
            Visit_Component_Instance (E);
247

248 0
         when others =>
249 0
            null;
250 1
      end case;
251 1
   end Visit;
252

253
   ---------------------------------
254
   -- Visit_Architecture_Instance --
255
   ---------------------------------
256

257 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
258
   begin
259 1
      Root_Node := Root_System (E);
260 1
      Visit (Root_Node);
261 1
   end Visit_Architecture_Instance;
262

263
   ------------------------------
264
   -- Visit_Component_Instance --
265
   ------------------------------
266

267 1
   procedure Visit_Component_Instance (E : Node_Id) is
268 1
      Category : constant Component_Category := Get_Category_Of_Component (E);
269
   begin
270 1
      case Category is
271 1
         when CC_System =>
272 1
            Visit_System_Instance (E);
273

274 1
         when CC_Process =>
275 1
            Visit_Process_Instance (E);
276

277 1
         when CC_Thread =>
278 1
            Visit_Thread_Instance (E);
279

280 1
         when CC_Processor =>
281 1
            Visit_Processor_Instance (E);
282

283 0
         when CC_Bus =>
284 0
            Visit_Bus_Instance (E);
285

286 1
         when CC_Virtual_Processor =>
287 1
            Visit_Virtual_Processor_Instance (E);
288

289 0
         when others =>
290 0
            null;
291 1
      end case;
292 1
   end Visit_Component_Instance;
293

294
   ---------------------------
295
   -- Visit_Thread_Instance --
296
   ---------------------------
297

298 1
   procedure Visit_Thread_Instance (E : Node_Id) is
299 1
      F : Node_Id;
300
   begin
301 1
      Process_Nb_Threads := Process_Nb_Threads + 1;
302

303 1
      if not AINU.Is_Empty (Features (E)) then
304 1
         F := First_Node (Features (E));
305

306 1
         while Present (F) loop
307 1
            if Kind (F) = K_Port_Spec_Instance then
308 1
               if Get_Connection_Pattern (F) = Intra_Process
309 1
                 and then Is_In (F)
310
               then
311 1
                  if AIN.Is_Data (F) and then not AIN.Is_Event (F) then
312 1
                     Process_Nb_Blackboards   := Process_Nb_Blackboards + 1;
313 1
                     Process_Blackboards_Size :=
314 1
                       Process_Blackboards_Size +
315 1
                       To_Bytes (Get_Data_Size (Corresponding_Instance (F)));
316 1
                  elsif AIN.Is_Data (F) and then AIN.Is_Event (F) then
317 1
                     Process_Nb_Buffers := Process_Nb_Buffers + 1;
318 0
                  elsif AIN.Is_Event (F) and then not AIN.Is_Data (F) then
319 0
                     Process_Nb_Events := Process_Nb_Events + 1;
320
                  else
321 0
                     Display_Error
322
                       ("Communication Pattern not handled",
323
                        Fatal => True);
324
                  end if;
325

326 1
                  Process_Nb_Lock_Objects := Process_Nb_Lock_Objects + 1;
327
               end if;
328
            end if;
329 1
            F := Next_Node (F);
330 1
         end loop;
331
      end if;
332

333 1
   end Visit_Thread_Instance;
334

335
   ----------------------------
336
   -- Visit_Process_Instance --
337
   ----------------------------
338

339 1
   procedure Visit_Process_Instance (E : Node_Id) is
340 1
      S : Node_Id;
341
   begin
342 1
      if not AINU.Is_Empty (Subcomponents (E)) then
343 1
         S := First_Node (Subcomponents (E));
344 1
         while Present (S) loop
345
            --  Visit the component instance corresponding to the
346
            --  subcomponent S.
347

348 1
            Visit (Corresponding_Instance (S));
349 1
            S := Next_Node (S);
350 1
         end loop;
351
      end if;
352 1
   end Visit_Process_Instance;
353

354
   ---------------------------
355
   -- Visit_System_Instance --
356
   ---------------------------
357

358 1
   procedure Visit_System_Instance (E : Node_Id) is
359 1
      S : Node_Id;
360
   begin
361 1
      if not AINU.Is_Empty (Subcomponents (E)) then
362 1
         S := First_Node (Subcomponents (E));
363 1
         while Present (S) loop
364
            --  Visit the component instance corresponding to the
365
            --  subcomponent S.
366 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
367 1
               Visit (Corresponding_Instance (S));
368
            end if;
369 1
            S := Next_Node (S);
370 1
         end loop;
371
      end if;
372 1
   end Visit_System_Instance;
373

374
   ------------------------
375
   -- Visit_Bus_Instance --
376
   ------------------------
377

378 0
   procedure Visit_Bus_Instance (E : Node_Id) is
379
      pragma Unreferenced (E);
380
   begin
381 0
      null;
382 0
   end Visit_Bus_Instance;
383

384
   ------------------------------
385
   -- Visit_Processor_Instance --
386
   ------------------------------
387

388 1
   procedure Visit_Processor_Instance (E : Node_Id) is
389 1
      S : Node_Id;
390 1
      U : Node_Id;
391 1
      P : Node_Id;
392
   begin
393 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
394 1
      P := XTN.Node (Backend_Node (Identifier (E)));
395

396 1
      Push_Entity (P);
397 1
      Push_Entity (U);
398

399 1
      Partition_Identifier := 1;
400

401 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
402

403 1
      Partitions_Node := Make_XML_Node ("Partitions");
404

405 1
      Append_Node_To_List (Partitions_Node, XTN.Subitems (Current_XML_Node));
406

407
      --
408
      --  First, make the <Partition/> nodes
409
      --
410

411 1
      if not AINU.Is_Empty (Subcomponents (E)) then
412 1
         S := First_Node (Subcomponents (E));
413 1
         while Present (S) loop
414
            --  Visit the component instance corresponding to the
415
            --  subcomponent S.
416

417 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
418 1
               Visit (Corresponding_Instance (S));
419
            end if;
420 1
            S := Next_Node (S);
421 1
         end loop;
422
      end if;
423

424 1
      Pop_Entity;
425 1
      Pop_Entity;
426 1
   end Visit_Processor_Instance;
427

428
   --------------------------------------
429
   -- Visit_Virtual_Processor_Instance --
430
   --------------------------------------
431

432 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
433 1
      S                     : Node_Id;
434 1
      F                     : Node_Id;
435 1
      Corresponding_Process : Node_Id := No_Node;
436 1
      Memory_Segment        : Node_Id := No_Node;
437 1
      Partition_Node        : Node_Id;
438 1
      Sampling_Ports        : Node_Id := No_Node;
439 1
      Queuing_Ports         : Node_Id := No_Node;
440
   begin
441

442 1
      Sampling_Ports := Make_XML_Node ("SamplingPorts");
443 1
      Queuing_Ports  := Make_XML_Node ("QueuingPorts");
444

445 1
      Corresponding_Process := Find_Associated_Process (E);
446

447 1
      if Corresponding_Process /= No_Node then
448

449 1
         Process_Nb_Threads       := 0;
450 1
         Process_Nb_Buffers       := 0;
451 1
         Process_Nb_Events        := 0;
452 1
         Process_Nb_Lock_Objects  := 0;
453 1
         Process_Nb_Blackboards   := 0;
454 1
         Process_Blackboards_Size := 0;
455 1
         Process_Buffers_Size     := 0;
456

457 1
         Visit (Corresponding_Process);
458

459
         --
460
         --  First, we create the description of the partition.
461
         --
462
         Partition_Node :=
463 1
           Map_Partition
464
             (Corresponding_Process,
465
              E,
466
              Partition_Identifier,
467
              Process_Nb_Threads,
468
              Process_Nb_Buffers,
469
              Process_Nb_Events,
470
              Process_Nb_Lock_Objects,
471
              Process_Nb_Blackboards,
472
              Process_Blackboards_Size,
473
              Process_Buffers_Size);
474 1
         Append_Node_To_List (Partition_Node, XTN.Subitems (Partitions_Node));
475

476
         --
477
         --  Then, we associate the partition with memory region
478
         --
479

480 1
         Memory_Regions := Make_XML_Node ("MemoryRegions");
481

482
         Memory_Segment :=
483 1
           Find_Associated_Memory_Segment (Corresponding_Process);
484

485 1
         if Memory_Segment = No_Node then
486 0
            Append_Node_To_List
487 0
              (Make_Default_Memory_Region,
488 0
               XTN.Subitems (Memory_Regions));
489
         else
490 1
            Append_Node_To_List
491 1
              (Make_Memory_Region (Memory_Segment),
492 1
               XTN.Subitems (Memory_Regions));
493
         end if;
494

495 1
         Append_Node_To_List (Memory_Regions, XTN.Subitems (Partition_Node));
496

497
         --
498
         --  Then, we configure the inter-partitions communication
499
         --  ports (sampling/queueing).
500
         --
501

502 1
         if not AINU.Is_Empty (Features (Corresponding_Process)) then
503 1
            F := First_Node (Features (Corresponding_Process));
504

505 1
            while Present (F) loop
506 1
               if Kind (F) = K_Port_Spec_Instance
507 1
                 and then Get_Connection_Pattern (F) = Inter_Process
508
               then
509

510 1
                  if Is_Data (F) and then not Is_Event (F) then
511 1
                     Append_Node_To_List
512 1
                       (Map_Sampling_Port (F),
513 1
                        XTN.Subitems (Sampling_Ports));
514
                  end if;
515

516 1
                  if Is_Data (F) and then Is_Event (F) then
517 1
                     Append_Node_To_List
518 1
                       (Map_Queuing_Port (F),
519 1
                        XTN.Subitems (Queuing_Ports));
520
                  end if;
521

522
               end if;
523 1
               F := Next_Node (F);
524 1
            end loop;
525
         end if;
526

527 1
         if Sampling_Ports /= No_Node
528 1
           and then XTN.Subitems (Sampling_Ports) /= No_List
529
         then
530 1
            Append_Node_To_List
531
              (Sampling_Ports,
532 1
               XTN.Subitems (Partition_Node));
533
         end if;
534

535 1
         if Queuing_Ports /= No_Node
536 1
           and then XTN.Subitems (Queuing_Ports) /= No_List
537
         then
538 1
            Append_Node_To_List (Queuing_Ports, XTN.Subitems (Partition_Node));
539
         end if;
540

541 1
         Partition_Identifier := Partition_Identifier + 1;
542
      end if;
543

544 1
      if not AINU.Is_Empty (Subcomponents (E)) then
545 0
         S := First_Node (Subcomponents (E));
546 0
         while Present (S) loop
547

548 0
            Visit (Corresponding_Instance (S));
549 0
            S := Next_Node (S);
550 0
         end loop;
551
      end if;
552 1
   end Visit_Virtual_Processor_Instance;
553

554
end Ocarina.Backends.Deos_Conf.Partitions;

Read our documentation on viewing source code .

Loading