OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                  OCARINA.BACKENDS.AIR_CONF.PARTITIONS                    --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2018-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
with Utils;         use Utils;
34

35
with Ocarina.ME_AADL;
36
with Ocarina.ME_AADL.AADL_Tree.Nodes;
37
with Ocarina.ME_AADL.AADL_Instances.Nodes;
38
with Ocarina.ME_AADL.AADL_Tree.Nutils;
39
with Ocarina.ME_AADL.AADL_Instances.Nutils;
40
with Ocarina.ME_AADL.AADL_Instances.Entities;
41
with Ocarina.ME_AADL.AADL_Tree.Entities;
42

43
with Ocarina.Backends.C_Common.Mapping;
44
with Ocarina.Backends.Utils;
45
with Ocarina.Instances.Queries;
46

47
with Ocarina.Backends.Messages;
48
with Ocarina.Backends.Properties;
49
with Ocarina.Backends.Properties.ARINC653;
50

51
with Ocarina.Backends.XML_Tree.Nodes;
52
with Ocarina.Backends.XML_Tree.Nutils;
53
with Ocarina.Backends.XML_Values;
54

55
package body Ocarina.Backends.AIR_Conf.Partitions is
56

57
   use Ocarina.ME_AADL;
58
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
59
   use Ocarina.ME_AADL.AADL_Instances.Entities;
60

61
   use Ocarina.Instances.Queries;
62
   use Ocarina.Backends.C_Common.Mapping;
63

64
   use Ocarina.Backends.Utils;
65
   use Ocarina.Backends.Messages;
66
   use Ocarina.Backends.Properties;
67
   use Ocarina.Backends.XML_Tree.Nutils;
68
   use Ocarina.Backends.Properties.ARINC653;
69

70
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
71
   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
72
   package ATNU renames Ocarina.ME_AADL.AADL_Tree.Nutils;
73
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
74
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
75
   package XTU renames Ocarina.Backends.XML_Tree.Nutils;
76
   package XV renames Ocarina.Backends.XML_Values;
77

78
   procedure Visit_Architecture_Instance (E : Node_Id);
79
   procedure Visit_Component_Instance (E : Node_Id);
80
   procedure Visit_System_Instance (E : Node_Id);
81
   procedure Visit_Process_Instance (E : Node_Id);
82
   procedure Visit_Processor_Instance (E : Node_Id);
83
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
84
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
85

86
   Current_System : Node_Id := No_Node;
87

88
   -----------
89
   -- Visit --
90
   -----------
91

92 1
   procedure Visit (E : Node_Id) is
93
   begin
94 1
      case Kind (E) is
95 1
         when K_Architecture_Instance =>
96 1
            Visit_Architecture_Instance (E);
97

98 1
         when K_Component_Instance =>
99 1
            Visit_Component_Instance (E);
100

101 0
         when others =>
102 0
            null;
103 1
      end case;
104 1
   end Visit;
105

106
   ---------------------------------
107
   -- Visit_Architecture_Instance --
108
   ---------------------------------
109

110 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
111
   begin
112 1
      Visit (Root_System (E));
113 1
   end Visit_Architecture_Instance;
114

115
   ------------------------------
116
   -- Visit_Component_Instance --
117
   ------------------------------
118

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

126 1
         when CC_Process =>
127 1
            Visit_Process_Instance (E);
128

129 1
         when CC_Processor =>
130 1
            Visit_Processor_Instance (E);
131

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

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

140
   -------------------
141
   -- Map_Partition --
142
   -------------------
143

144
   procedure Map_Partition (E : Node_Id)
145 1
      with Pre => (Get_Category_Of_Component (E) = CC_Process);
146

147 1
   procedure Map_Partition (E : Node_Id) is
148 1
      Partition_Node       : Node_Id;
149 1
      Byte_Count_Value     : Unsigned_Long_Long;
150 1
      Associated_Processor : Node_Id;
151 1
      Associated_Module    : Node_Id;
152 1
      Associated_Memory    : Node_Id;
153 1
      PartitionConfiguration : Node_Id;
154 1
      Port_Node            : Node_Id;
155 1
      Memory_Node          : Node_Id;
156 1
      Libs_Node            : Node_Id;
157 1
      Devices_Node         : Node_Id;
158 1
      Cache_Node : Node_Id;
159 1
      Permissions_Node : Node_Id;
160 1
      P                    : Node_Id;
161 1
      Q                    : Node_Id;
162 1
      F                    : Node_Id;
163 1
      Personnality         : Supported_Execution_Platform;
164
   begin
165 1
      Associated_Processor := Get_Bound_Processor (E);
166 1
      Associated_Memory    := Get_Bound_Memory (E);
167
      Associated_Module    :=
168 1
        Parent_Component (Parent_Subcomponent (Associated_Processor));
169 1
      Personnality := Get_Execution_Platform (Associated_Processor);
170

171
      --  Some checks on the model in order to make sure that
172
      --  everything is correctly defined.
173

174 1
      if Associated_Processor = No_Node then
175 0
         Display_Located_Error
176 0
           (AIN.Loc (E),
177
            "A partition has to be associated with one virtual processor.",
178
            Fatal => True);
179
      end if;
180

181 1
      if Associated_Memory = No_Node then
182 0
         Display_Located_Error
183 0
           (AIN.Loc (E),
184
            "A partition has to be associated with one memory.",
185
            Fatal => True);
186
      end if;
187

188 1
      if Associated_Module = No_Node then
189 0
         Display_Located_Error
190 0
           (AIN.Loc (E),
191
            "Unable to retrieve the module that executes this partition.",
192
            Fatal => True);
193
      end if;
194

195
      --  Create the Partition node, that defines all partition requirements
196

197 1
      Append_Node_To_List
198 1
        (Make_XML_Comment (Get_String_Name ("Partition")),
199 1
         XTN.Subitems (Current_XML_Node));
200

201 1
      Partition_Node := Make_XML_Node ("Partition");
202

203
      --  a) id of the partition
204

205 1
      Set_Str_To_Name_Buffer ("PartitionIdentifier");
206 1
      P := Make_Defining_Identifier (Name_Find);
207
      Q :=
208 1
        Make_Literal
209 1
          (XV.New_Numeric_Value
210 1
             (Get_Partition_Identifier
211
                (Associated_Processor),
212
              0,
213
              10));
214 1
      Append_Node_To_List
215 1
        (Make_Assignement (P, Q),
216 1
         XTN.Items (Partition_Node));
217

218
      --  b) name of the partition
219

220 1
      Set_Str_To_Name_Buffer ("PartitionName");
221 1
      P := Make_Defining_Identifier (Name_Find);
222 1
      Get_Name_String
223 1
        (To_Lower
224 1
           (Display_Name
225 1
              (Identifier (Parent_Subcomponent (E)))));
226

227
      --  Note: we store the node_id of the process bound to the
228
      --  current virtual processor (partition). We use the name of
229
      --  the process to match code generation rules, where processes
230
      --  name are used for each sub-directory.
231

232 1
      AIN.Set_Backend_Node (Identifier (Associated_Processor), E);
233

234 1
      Q := Make_Defining_Identifier (Name_Find);
235 1
      Append_Node_To_List
236 1
        (Make_Assignement (P, Q),
237 1
         XTN.Items (Partition_Node));
238

239
      --  c) XXX hard-coded configuration parameters
240

241 1
      XTU.Add_Attribute ("Criticality", "LEVEL_A", Partition_Node);
242 1
      XTU.Add_Attribute ("EntryPoint", "entry_func", Partition_Node);
243 1
      XTU.Add_Attribute ("SystemPartition", "false", Partition_Node);
244

245
      --  Now, handle the ports of the partition.
246

247 1
      if Has_Ports (E) then
248 1
         F := First_Node (Features (E));
249 1
         while Present (F) loop
250 1
            if Kind (F) = K_Port_Spec_Instance then
251

252
               --  XXX move out as REAL checks
253

254 1
               if not Is_Data (F) then
255 0
                  Display_Located_Error
256 0
                    (AIN.Loc (F),
257
                     "Pure events ports are not allowed.",
258
                     Fatal => True);
259
               end if;
260

261 1
               if Is_In (F) and then Is_Out (F) then
262 0
                  Display_Located_Error
263 0
                    (AIN.Loc (F),
264
                     "in/out ports are not allowed.",
265
                     Fatal => True);
266
               end if;
267

268
               --  Type of port
269

270 1
               if Is_Data (F) and then not Is_Event (F) then
271 0
                  Port_Node := Make_XML_Node ("Sampling_Port");
272
               else
273 1
                  Port_Node := Make_XML_Node ("Queuing_Port");
274
               end if;
275

276
               --  Port name: partition + port name
277

278 1
               Set_Str_To_Name_Buffer ("Name");
279 1
               P := Make_Defining_Identifier (Name_Find);
280

281 1
               Get_Name_String
282 1
                 (Map_C_Enumerator_Name (F,
283
                                         Fully_Qualify_Parent => True));
284

285 1
               Q := Make_Defining_Identifier (To_Lower (Name_Find));
286 1
               Append_Node_To_List
287 1
                 (Make_Assignement (P, Q),
288 1
                  XTN.Items (Port_Node));
289

290
               --  Direction
291

292 1
               Set_Str_To_Name_Buffer ("Direction");
293 1
               P := Make_Defining_Identifier (Name_Find);
294

295 1
               if Is_In (F) then
296 1
                  Set_Str_To_Name_Buffer ("DESTINATION");
297
               else
298 1
                  Set_Str_To_Name_Buffer ("SOURCE");
299
               end if;
300

301 1
               Q := Make_Defining_Identifier (Name_Find);
302 1
               Append_Node_To_List
303 1
                 (Make_Assignement (P, Q),
304 1
                  XTN.Items (Port_Node));
305

306
               --  MaxMessageSize
307

308 1
               if Get_Data_Size (Corresponding_Instance (F)) /= Null_Size then
309
                  --  If data size is specified, use this value, add
310
                  --  40 to take into account PolyORB-HI/C header
311
                  --  (conservative value).
312

313 1
                  Q :=
314 1
                    Make_Literal
315 1
                      (XV.New_Numeric_Value
316 1
                         (40 + To_Bytes
317 1
                            (Get_Data_Size (Corresponding_Instance (F))),
318
                          1,
319
                          10));
320
               else
321 0
                  Display_Located_Error
322 0
                    (Loc (F),
323
                     "No data size given for data size",
324
                     Fatal => True);
325
               end if;
326

327 1
               Set_Str_To_Name_Buffer ("MaxMessageSize");
328 1
               P := Make_Defining_Identifier (Name_Find);
329

330 1
               Append_Node_To_List
331 1
                 (Make_Assignement (P, Q), XTN.Items (Port_Node));
332

333
               --  MaxNbMessages
334

335 1
               if Is_Event (F) then
336 1
                  if Get_Queue_Size (F) /= -1 then
337
                     Q :=
338 0
                       Make_Literal
339 0
                       (XV.New_Numeric_Value
340 0
                          (Unsigned_Long_Long (Get_Queue_Size (F)),
341
                           1,
342
                           10));
343
                  else
344 1
                     Q := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
345
                  end if;
346

347 1
                  Set_Str_To_Name_Buffer ("MaxNbMessages");
348 1
                  P := Make_Defining_Identifier (Name_Find);
349

350 1
                  Append_Node_To_List
351 1
                    (Make_Assignement (P, Q), XTN.Items (Port_Node));
352
               end if;
353

354 1
               if Is_Data (F) then
355
                  --  RefreshRateSeconds
356

357 1
                  XTU.Add_Attribute ("RefreshRateSeconds", "1.0", Port_Node);
358
                  --  XXX hardcoded
359

360 1
                  Append_Node_To_List
361 1
                    (Port_Node, XTN.Subitems (Partition_Node));
362
               end if;
363

364
            end if;
365 1
            F := Next_Node (F);
366 1
         end loop;
367
      end if;
368

369
      --  Create the PartitionConfiguration associated with the partition.
370

371 1
      PartitionConfiguration := Make_XML_Node ("PartitionConfiguration");
372

373 1
      if Personnality = Platform_AIR then
374 1
         XTU.Add_Attribute ("Personality", "RTEMS5",
375
                            PartitionConfiguration);
376 0
      elsif Personnality = Platform_AIR_IOP then
377 0
         XTU.Add_Attribute ("Personality", "Bare",
378
                            PartitionConfiguration);
379
      else
380 0
         raise Program_Error with "Unsupported platform " & Personnality'Img;
381
      end if;
382

383 1
      XTU.Add_Attribute ("Cores", "1",
384
                         PartitionConfiguration); -- XXX hardcoded
385

386 1
      Append_Node_To_List (PartitionConfiguration,
387 1
                           XTN.Subitems (Partition_Node));
388

389
      --  Libs node, child of PartitionConfiguration
390

391 1
      Libs_Node := Make_XML_Node ("Libs");
392 1
      Append_Node_To_List (Libs_Node, XTN.Subitems (Partitionconfiguration));
393

394 1
      if Personnality = Platform_AIR then
395 1
         Append_Node_To_List
396 1
           (Make_Defining_Identifier
397 1
              (Get_String_Name ("LIBAIR; IMASPEX; LIBPRINTF")),
398 1
            XTN.Subitems (Libs_Node));
399 0
      elsif Personnality = Platform_AIR_IOP then
400 0
         Append_Node_To_List
401 0
           (Make_Defining_Identifier
402 0
              (Get_String_Name ("LIBIOP")),
403 0
            XTN.Subitems (Libs_Node));
404
      end if;
405

406
      --  Devices node, child of PartitionConfiguration
407

408 1
      Devices_Node := Make_XML_Node ("Devices");
409 1
      Append_Node_To_List (Devices_Node,
410 1
                           XTN.Subitems (Partitionconfiguration));
411

412
      --  Cache node, child of PartitionConfiguration
413

414 1
      Cache_Node := Make_XML_Node ("Cache");
415 1
      Append_Node_To_List (Cache_Node, XTN.Subitems (Partitionconfiguration));
416

417 1
      Append_Node_To_List
418 1
        (Make_Defining_Identifier
419 1
           (Get_String_Name ("CODE; DATA")), --  XXX hardcoded
420 1
         XTN.Subitems (Cache_Node));
421

422
      --  Memory node, child of PartitionConfiguration
423

424 1
      Memory_Node := Make_XML_Node ("Memory");
425

426
      Byte_Count_Value :=
427 1
        Get_Integer_Property (Associated_Memory, "byte_count");
428 1
      Set_Str_To_Name_Buffer ("Size");
429 1
      P := Make_Defining_Identifier (Name_Find);
430 1
      Set_Str_To_Name_Buffer ("0x");
431 1
      Add_ULL_To_Name_Buffer (Byte_Count_Value, 16);
432

433 1
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
434

435 1
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
436

437 1
      Append_Node_To_List (Memory_Node, XTN.Subitems (Partitionconfiguration));
438

439
      --  Permissions node, child of PartitionConfiguration
440

441 1
      Permissions_Node := Make_XML_Node ("Permissions");
442

443 1
      if Personnality = Platform_AIR then
444 1
         Append_Node_To_List
445 1
           (Make_Defining_Identifier
446 1
              (Get_String_Name
447
                 ("FPU_CONTROL; GLOBAL_TIME; CACHE_CONTROL;"
448
                    & "SET_TOD; SET_PARTITION_MODE;")), --  XXX hardcoded
449 1
            XTN.Subitems (Permissions_Node));
450 0
      elsif Personnality = Platform_AIR_IOP then
451 0
         Append_Node_To_List
452 0
           (Make_Defining_Identifier (Get_String_Name ("SUPERVISOR;")),
453 0
            XTN.Subitems (Permissions_Node));
454
      end if;
455

456 1
      Append_Node_To_List (Permissions_Node,
457 1
                           XTN.Subitems (Partitionconfiguration));
458

459 1
      Append_Node_To_List (Partition_Node, XTN.Subitems (Current_XML_Node));
460 1
   end Map_Partition;
461

462
   -------------------------
463
   -- Map_Module_Schedule --
464
   -------------------------
465

466
   procedure Map_Module_Schedule (E : Node_Id)
467 1
      with Pre => (Get_Category_Of_Component (E) = CC_Processor);
468

469 1
   procedure Map_Module_Schedule (E : Node_Id) is
470 1
      Schedule_Identifier : constant Unsigned_Long_Long := 1;
471 1
      Window_Identifier : Unsigned_Long_Long := 0;
472

473 1
      Module_Schedule : constant Schedule_Window_Record_Term_Array :=
474 1
        Get_Module_Schedule_Property (E);
475

476 1
      Module_Schedule_Node : Node_Id;
477 1
      Window_Schedule_Node : Node_Id;
478

479 1
      P, Q, S : Node_Id;
480

481 1
      Partition_Node : Node_Id;
482 1
      Partition       : Node_Id;
483

484 1
      Start_Time      : Long_Double := 0.0;
485

486
   begin
487 1
      if Module_Schedule'Length = 0 then
488 0
         Display_Error
489
           ("You must provide the slots allocation for each processor",
490
            Fatal => True);
491
      end if;
492

493 1
      Append_Node_To_List
494 1
        (Make_XML_Comment
495 1
           (Get_String_Name ("Schedule" & Schedule_Identifier'Img)),
496 1
         XTN.Subitems (Current_XML_Node));
497

498
      --  Module_Schedule root node
499

500 1
      Module_Schedule_Node := Make_XML_Node ("Module_Schedule");
501

502 1
      Append_Node_To_List (Module_Schedule_Node,
503 1
                           XTN.Subitems (Current_XML_Node));
504

505
      --  Associate a fixed identifier to the slot.
506

507 1
      Set_Str_To_Name_Buffer ("ScheduleIdentifier");
508 1
      P := Make_Defining_Identifier (Name_Find);
509 1
      Q := Make_Literal (XV.New_Numeric_Value (Schedule_Identifier, 0, 10));
510 1
      Append_Node_To_List (Make_Assignement (P, Q),
511 1
                           XTN.Items (Module_Schedule_Node));
512

513
      --  Schedule name
514

515 1
      Set_Str_To_Name_Buffer ("ScheduleName");
516 1
      P := Make_Defining_Identifier (Name_Find);
517

518 1
      Set_Str_To_Name_Buffer
519 1
        ("schedule_" & Schedule_Identifier'Img);
520 1
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
521

522 1
      Append_Node_To_List (Make_Assignement (P, Q),
523 1
                           XTN.Items (Module_Schedule_Node));
524

525
      --  InitialModuleSchedule
526

527 1
      XTU.Add_Attribute
528
        ("InitialModuleSchedule", "true", Module_Schedule_Node);
529

530
      --  MajorFrameSeconds
531

532 1
      Set_Str_To_Name_Buffer ("MajorFrameSeconds");
533 1
      P := Make_Defining_Identifier (Name_Find);
534

535 1
      Set_Str_To_Name_Buffer
536 1
        (Long_Double'Image (To_Seconds (Get_POK_Major_Frame (E))));
537 1
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
538

539 1
      Append_Node_To_List (Make_Assignement (P, Q),
540 1
                           XTN.Items (Module_Schedule_Node));
541

542
      --  For each time slot for a partition, we declare
543
      --  it in the scheduling plan.
544

545 1
      for J in Module_Schedule'Range loop
546 1
         Partition := Module_Schedule (J).Partition;
547

548
         --  Create the node that corresponds to the slot.
549 1
         Partition_Node := Make_XML_Node ("Partition_Schedule");
550 1
         Append_Node_To_List (Partition_Node,
551 1
                              XTN.Subitems (Module_Schedule_Node));
552

553
         --  XXX The following is a work-around to address limit in
554
         --  instantiation of record properties ????
555

556 1
         if not AINU.Is_Empty (Subcomponents (E)) then
557 1
            S := First_Node (Subcomponents (E));
558 1
            while Present (S) loop
559 1
               if Corresponding_Declaration (S) =
560
                 Module_Schedule (J).Partition
561
               then
562 1
                  Partition := Corresponding_Instance (S);
563
               end if;
564 1
               S := Next_Node (S);
565 1
            end loop;
566
         end if;
567

568
         --  PartitionName
569

570 1
         Set_Str_To_Name_Buffer ("PartitionName");
571 1
         P := Make_Defining_Identifier (Name_Find);
572

573
         --  Note: we retrieve the identifier of the process bound to
574
         --  this virtual processor, stored in backend_node
575

576 1
         Get_Name_String
577 1
           (To_Lower
578 1
              (Display_Name
579 1
                 (Identifier (Parent_Subcomponent
580 1
                                (AIN.Backend_Node
581 1
                                   (Identifier (Partition)))))));
582

583 1
         Q := Make_Defining_Identifier (Name_Find);
584 1
         Append_Node_To_List
585 1
           (Make_Assignement (P, Q),
586 1
            XTN.Items (Partition_Node));
587

588
         --  PartitionIdentifier
589

590 1
         Set_Str_To_Name_Buffer ("PartitionIdentifier");
591 1
         P := Make_Defining_Identifier (Name_Find);
592

593
         Q :=
594 1
           Make_Literal
595 1
             (XV.New_Numeric_Value
596 1
                (Get_Partition_Identifier (Partition),
597
                 0,
598
                 10));
599 1
         Append_Node_To_List (Make_Assignement (P, Q),
600 1
                              XTN.Items (partition_Node));
601

602
         --  PeriodDurationSeconds
603

604 1
         Set_Str_To_Name_Buffer ("PeriodDurationSeconds");
605 1
         P := Make_Defining_Identifier (Name_Find);
606

607 1
         Set_Str_To_Name_Buffer
608 1
           (Long_Double'Image
609 1
              (To_Seconds (Module_Schedule (J).Duration)));
610 1
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
611 1
         Append_Node_To_List (Make_Assignement (P, Q),
612 1
                              XTN.Items (Partition_Node));
613

614
         --  PeriodSeconds
615

616 1
         Set_Str_To_Name_Buffer ("PeriodSeconds");
617 1
         P := Make_Defining_Identifier (Name_Find);
618

619 1
         Set_Str_To_Name_Buffer
620 1
           (Long_Double'Image (To_Seconds (Get_POK_Major_Frame (E))));
621 1
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
622

623 1
         Append_Node_To_List (Make_Assignement (P, Q),
624 1
                              XTN.Items (Partition_Node));
625

626
         --  WindowSchedule node, child of Partition_Schedule node
627

628 1
         Window_Schedule_Node := Make_XML_Node ("Window_Schedule");
629 1
         Append_Node_To_List (Window_Schedule_Node,
630 1
                              XTN.Subitems (Partition_Node));
631

632 1
         Xtu.Add_Attribute ("PartitionPeriodStart", "true",
633
                            Window_Schedule_Node); --  XXX hardcoded
634

635 1
         Set_Str_To_Name_Buffer ("WindowDurationSeconds");
636 1
         P := Make_Defining_Identifier (Name_Find);
637

638 1
         Set_Str_To_Name_Buffer
639 1
           (Long_Double'Image
640 1
              (To_Seconds (Module_Schedule (J).Duration)));
641 1
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
642 1
         Append_Node_To_List (Make_Assignement (P, Q),
643 1
                              XTN.Items (Window_Schedule_Node));
644

645 1
         Set_Str_To_Name_Buffer ("WindowIdentifier");
646 1
         P := Make_Defining_Identifier (Name_Find);
647 1
         Q := Make_Literal (XV.New_Numeric_Value
648 1
                              (Schedule_Identifier * 10 + Window_Identifier,
649
                               0, 10));
650 1
         Append_Node_To_List (Make_Assignement (P, Q),
651 1
                              XTN.Items (Window_Schedule_Node));
652

653
         --  Definition of the Cores attribute
654

655
         declare
656 1
            Cores : constant List_Id := Get_Bound_Processor_L (Partition);
657 1
            S : Node_Id;
658 1
            Core : Node_Id;
659 1
            List_Of_Cores : Name_Id := No_Name;
660 1
            First_Run : Boolean := True;
661
         begin
662
            --  For partition Partition, we iterate on the list of
663
            --  processors this partition is bound to, for each
664
            --  partition, we get is Core_Id and build a ';' separated
665
            --  string with numerical Core_Id value.
666

667 1
            if not ATNU.Is_Empty (Cores) then
668 1
               S := ATN.First_Node (Cores);
669 1
               while Present (S) loop
670
                  Core :=
671 1
                    Ocarina.ME_AADL.AADL_Tree.Entities.Get_Referenced_Entity
672
                    (S);
673 1
                  if First_Run then
674 1
                     First_Run := False;
675 1
                     Set_Str_To_Name_Buffer
676 1
                       (Ocarina.Backends.Properties.Get_Core_Id (Core)'Img);
677
                  else
678 1
                     Get_Name_String (List_Of_Cores);
679 1
                     Add_Char_To_Name_Buffer (';');
680 1
                     Add_Str_To_Name_Buffer
681 1
                       (Ocarina.Backends.Properties.Get_Core_Id (Core)'Img);
682
                  end if;
683 1
                  List_Of_Cores := Name_Find;
684 1
                  S := ATN.Next_Node (S);
685 1
               end loop;
686

687 1
               Set_Str_To_Name_Buffer ("Cores");
688 1
               P := Make_Defining_Identifier (Name_Find);
689 1
               Q := Make_Defining_Identifier
690 1
                 (Remove_Char (List_Of_Cores, ' '));
691 1
               Append_Node_To_List (Make_Assignement (P, Q),
692 1
                                    XTN.Items (Window_Schedule_Node));
693
            end if;
694

695
         end;
696

697 1
         Window_Identifier := Window_Identifier + 1;
698 1
         if Window_Identifier = 10 then
699 0
            raise Program_Error;
700
         end if;
701

702
         --  Define the start attribute of the <slot/> element.
703 1
         Set_Str_To_Name_Buffer ("WindowStartSeconds");
704 1
         P := Make_Defining_Identifier (Name_Find);
705 1
         Set_Str_To_Name_Buffer (Long_Double'Image (Start_Time));
706 1
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
707 1
         Append_Node_To_List (Make_Assignement (P, Q),
708 1
                              XTN.Items (Window_Schedule_Node));
709

710 1
         Start_Time := Start_Time + To_Seconds (Module_Schedule (J).Duration);
711

712 1
      end loop;
713

714 1
   end Map_Module_Schedule;
715

716
   ----------------------------
717
   -- Visit_Process_Instance --
718
   ----------------------------
719

720 1
   procedure Visit_Process_Instance (E : Node_Id) is
721
   begin
722 1
      Map_Partition (E);
723 1
   end Visit_Process_Instance;
724

725
   ---------------------------
726
   -- Visit_System_Instance --
727
   ---------------------------
728

729 1
   procedure Visit_System_Instance (E : Node_Id) is
730 1
      S : Node_Id;
731 1
      U : Node_Id;
732 1
      R : Node_Id;
733
   begin
734 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
735 1
      R := XTN.Node (Backend_Node (Identifier (E)));
736

737 1
      Current_System := E;
738

739 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
740

741 1
      Push_Entity (U);
742 1
      Push_Entity (R);
743

744 1
      if not AINU.Is_Empty (Subcomponents (E)) then
745 1
         S := First_Node (Subcomponents (E));
746 1
         while Present (S) loop
747
            --  Visit the component instance corresponding to the
748
            --  subcomponent S.
749 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
750 1
               Visit (Corresponding_Instance (S));
751
            end if;
752 1
            S := Next_Node (S);
753 1
         end loop;
754
      end if;
755

756 1
      Pop_Entity;
757 1
      Pop_Entity;
758 1
   end Visit_System_Instance;
759

760
   ------------------------------
761
   -- Visit_Processor_Instance --
762
   ------------------------------
763

764 1
   procedure Visit_Processor_Instance (E : Node_Id) is
765
   begin
766 1
      Visit_Subcomponents_Of (E);
767 1
      Map_Module_Schedule (E);
768 1
   end Visit_Processor_Instance;
769

770
   --------------------------------------
771
   -- Visit_Virtual_Processor_Instance --
772
   --------------------------------------
773

774 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
775 1
      S : Node_Id;
776
   begin
777 1
      if not AINU.Is_Empty (Subcomponents (Current_System)) then
778 1
         S := First_Node (Subcomponents (Current_System));
779 1
         while Present (S) loop
780
            --  Visit the component instance corresponding to the
781
            --  subcomponent S.
782 1
            if AINU.Is_Process (Corresponding_Instance (S))
783 1
              and then Get_Bound_Processor (Corresponding_Instance (S)) = E
784
            then
785 1
               Visit (Corresponding_Instance (S));
786
            end if;
787 1
            S := Next_Node (S);
788 1
         end loop;
789
      end if;
790

791 1
      Visit_Subcomponents_Of (E);
792 1
   end Visit_Virtual_Processor_Instance;
793

794
end Ocarina.Backends.AIR_Conf.Partitions;

Read our documentation on viewing source code .

Loading