ocarina-backends-xtratum_conf-partition_table.adb 17.1 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--              OCARINA.BACKENDS.XTRATUM_CONF.PARTITION_TABLE               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--                   Copyright (C) 2011-2016 ESA & ISAE.                    --
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27 28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29 30 31
--                                                                          --
------------------------------------------------------------------------------

32
with Ocarina.Namet; use Ocarina.Namet;
yoogx's avatar
yoogx committed
33
with Utils;         use Utils;
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Entities;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;

with Ocarina.Backends.Utils;
with Ocarina.Instances.Queries;

with Ocarina.Backends.Messages;
with Ocarina.Backends.Properties;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;

package body Ocarina.Backends.Xtratum_Conf.Partition_Table is

   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
   use Ocarina.ME_AADL.AADL_Instances.Entities;

   use Ocarina.Instances.Queries;

   use Ocarina.Backends.Utils;
   use Ocarina.Backends.Messages;
   use Ocarina.Backends.Properties;
   use Ocarina.Backends.XML_Tree.Nutils;

   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
   package ATE renames Ocarina.ME_AADL.AADL_Tree.Entities;
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;

   procedure Visit_Architecture_Instance (E : Node_Id);
   procedure Visit_Component_Instance (E : Node_Id);
   procedure Visit_System_Instance (E : Node_Id);
   procedure Visit_Process_Instance (E : Node_Id);
   procedure Visit_Processor_Instance (E : Node_Id);
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);

76 77
   Current_System : Node_Id := No_Node;

78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
   -----------
   -- Visit --
   -----------

   procedure Visit (E : Node_Id) is
   begin
      case Kind (E) is
         when K_Architecture_Instance =>
            Visit_Architecture_Instance (E);

         when K_Component_Instance =>
            Visit_Component_Instance (E);

         when others =>
            null;
      end case;
   end Visit;

   ---------------------------------
   -- Visit_Architecture_Instance --
   ---------------------------------

   procedure Visit_Architecture_Instance (E : Node_Id) is
   begin
      Visit (Root_System (E));
   end Visit_Architecture_Instance;

   ------------------------------
   -- Visit_Component_Instance --
   ------------------------------

   procedure Visit_Component_Instance (E : Node_Id) is
110
      Category : constant Component_Category := Get_Category_Of_Component (E);
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
   begin
      case Category is
         when CC_System =>
            Visit_System_Instance (E);

         when CC_Process =>
            Visit_Process_Instance (E);

         when CC_Processor =>
            Visit_Processor_Instance (E);

         when CC_Virtual_Processor =>
            Visit_Virtual_Processor_Instance (E);

         when others =>
            null;
      end case;
   end Visit_Component_Instance;

   ----------------------------
   -- Visit_Process_Instance --
   ----------------------------

   procedure Visit_Process_Instance (E : Node_Id) is
      Partition_Node       : Node_Id;
136 137
      Base_Address_Value   : Unsigned_Long_Long;
      Byte_Count_Value     : Unsigned_Long_Long;
138 139 140 141 142
      Associated_Processor : Node_Id;
      Associated_Module    : Node_Id;
      Associated_Memory    : Node_Id;
      Physical_Areas_Node  : Node_Id;
      Temporal_Req_Node    : Node_Id;
143 144
      Port_Table_Node      : Node_Id;
      Port_Node            : Node_Id;
145 146 147 148
      Area_Node            : Node_Id;
      P                    : Node_Id;
      Q                    : Node_Id;
      S                    : Node_Id;
149
      F                    : Node_Id;
150 151
   begin
      Associated_Processor := Get_Bound_Processor (E);
152 153 154
      Associated_Memory    := Get_Bound_Memory (E);
      Associated_Module    :=
        Parent_Component (Parent_Subcomponent (Associated_Processor));
155 156 157 158 159 160

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

      if Associated_Processor = No_Node then
         Display_Located_Error
161 162 163
           (AIN.Loc (E),
            "A partition has to be associated with one virtual processor.",
            Fatal => True);
164 165 166 167
      end if;

      if Associated_Memory = No_Node then
         Display_Located_Error
168 169 170
           (AIN.Loc (E),
            "A partition has to be associated with one memory.",
            Fatal => True);
171 172 173 174
      end if;

      if Associated_Module = No_Node then
         Display_Located_Error
175 176 177
           (AIN.Loc (E),
            "Unable to retrieve the module that executes this partition.",
            Fatal => True);
178 179 180 181 182 183 184
      end if;

      --  Create the main partition node that defines all partition
      --  requirements.

      Partition_Node := Make_XML_Node ("Partition");

185 186
      --  a) id of the partition

187
      Set_Str_To_Name_Buffer ("id");
188 189 190
      P := Make_Defining_Identifier (Name_Find);
      Q := Copy_Node (Backend_Node (Identifier (Associated_Processor)));
      Append_Node_To_List
191 192
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
193

194 195
      --  b) name of the partition

196 197 198
      Set_Str_To_Name_Buffer ("name");
      P := Make_Defining_Identifier (Name_Find);
      Get_Name_String
199
        (To_Lower (Display_Name (Identifier (Parent_Subcomponent (E)))));
200 201
      Q := Make_Defining_Identifier (Name_Find);
      Append_Node_To_List
202 203
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
204

205 206 207 208
      --  c) hard-coded configuration parameters, part 1

      Set_Str_To_Name_Buffer ("flags");
      P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
209
      Set_Str_To_Name_Buffer ("system fp");
210 211 212 213 214 215 216
      Q := Make_Defining_Identifier (Name_Find);
      Append_Node_To_List
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));

      --  d) hard-coded configuration parameters, part 2

217 218 219 220 221
      Set_Str_To_Name_Buffer ("console");
      P := Make_Defining_Identifier (Name_Find);
      Set_Str_To_Name_Buffer ("Uart");
      Q := Make_Defining_Identifier (Name_Find);
      Append_Node_To_List
222 223
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
224 225 226 227 228 229

      --  Create the PhysicalAreasNode associated with the partition.
      --  It maps the requirements of the memory component associated
      --  with the partition.
      Physical_Areas_Node := Make_XML_Node ("PhysicalMemoryAreas");

230
      Append_Node_To_List (Physical_Areas_Node, XTN.Subitems (Partition_Node));
231 232 233

      Area_Node := Make_XML_Node ("Area");

234
      Base_Address_Value :=
235
        Get_Integer_Property (Associated_Memory, "base_address");
236
      Byte_Count_Value :=
237
        Get_Integer_Property (Associated_Memory, "byte_count");
238 239
      Set_Str_To_Name_Buffer ("start");
      P := Make_Defining_Identifier (Name_Find);
240
      Set_Str_To_Name_Buffer ("0x");
241
      Add_ULL_To_Name_Buffer (Base_Address_Value, 16);
242 243

      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
244

245
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Area_Node));
246 247

      Set_Str_To_Name_Buffer ("size");
248
      P                := Make_Defining_Identifier (Name_Find);
249
      Byte_Count_Value := Byte_Count_Value / 1024;
250
      Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Byte_Count_Value));
251
      Add_Str_To_Name_Buffer ("KB");
252
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
253

254
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Area_Node));
255

256
      Append_Node_To_List (Area_Node, XTN.Subitems (Physical_Areas_Node));
257 258 259 260 261 262 263 264

      --  Create the TemporalRequirements node associated with the partition.
      --  It maps the requirements of the virtual processor component
      --  associated with the partition.

      Temporal_Req_Node := Make_XML_Node ("TemporalRequirements");

      declare
265 266
         Slots : constant Time_Array := Get_POK_Slots (Associated_Module);
         Slots_Allocation : constant List_Id    :=
267
            Get_POK_Slots_Allocation (Associated_Module);
268 269
         Duration    : Unsigned_Long_Long          := 0;
         Major_Frame : constant Unsigned_Long_Long :=
270
            To_Milliseconds (Get_POK_Major_Frame (Associated_Module));
271
         Part : Node_Id;
272
      begin
273 274 275 276 277 278 279 280 281 282 283 284 285
         if Present (Slots_Allocation) then
            --   XXX this code must be adjusted, the property
            --   Slots_Allocation has been deprecated by AADL, and the
            --   TemporalRequirements node in XtratuM is reserved for
            --   future usage.

            S := ATN.First_Node (Slots_Allocation);
            for J in Slots'Range loop
               Part := ATE.Get_Referenced_Entity (S);

               if Part = Associated_Processor then
                  Duration := Duration + To_Milliseconds (Slots (J));
               end if;
286

287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307
               S := ATN.Next_Node (S);
            end loop;
            Set_Str_To_Name_Buffer ("duration");
            P := Make_Defining_Identifier (Name_Find);
            Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Duration));
            Add_Str_To_Name_Buffer ("ms");
            Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));

            Append_Node_To_List
              (Make_Assignement (P, Q),
               XTN.Items (Temporal_Req_Node));

            Set_Str_To_Name_Buffer ("period");
            P := Make_Defining_Identifier (Name_Find);
            Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Major_Frame));
            Add_Str_To_Name_Buffer ("ms");
            Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));

            Append_Node_To_List
              (Make_Assignement (P, Q),
               XTN.Items (Temporal_Req_Node));
yoogx's avatar
yoogx committed
308 309 310

            Append_Node_To_List
              (Temporal_Req_Node, XTN.Subitems (Partition_Node));
311
         end if;
312 313
      end;

314
      --  Now, handle the ports of the partition.
315

316 317 318 319 320 321 322
      if Has_Ports (E) then
         Port_Table_Node := Make_XML_Node ("PortTable");

         F := First_Node (Features (E));
         while Present (F) loop
            if Kind (F) = K_Port_Spec_Instance then

323 324
               --  XXX move out as REAL checks

325 326
               if not Is_Data (F) then
                  Display_Located_Error
327 328 329
                    (AIN.Loc (F),
                     "Pure events ports are not allowed.",
                     Fatal => True);
330 331 332 333
               end if;

               if Is_In (F) and then Is_Out (F) then
                  Display_Located_Error
334 335 336
                    (AIN.Loc (F),
                     "in/out ports are not allowed.",
                     Fatal => True);
337 338 339 340 341 342 343 344 345 346
               end if;

               Port_Node := Make_XML_Node ("Port");

               Set_Str_To_Name_Buffer ("type");
               P := Make_Defining_Identifier (Name_Find);

               if Is_Data (F) and then not Is_Event (F) then
                  Set_Str_To_Name_Buffer ("sampling");
               else
347
                  Set_Str_To_Name_Buffer ("queuing");
348 349 350 351
               end if;

               Q := Make_Defining_Identifier (Name_Find);
               Append_Node_To_List
352 353
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));
354 355 356 357 358 359 360 361 362 363 364 365

               Set_Str_To_Name_Buffer ("direction");
               P := Make_Defining_Identifier (Name_Find);

               if Is_In (F) then
                  Set_Str_To_Name_Buffer ("destination");
               else
                  Set_Str_To_Name_Buffer ("source");
               end if;

               Q := Make_Defining_Identifier (Name_Find);
               Append_Node_To_List
366 367
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));
368

369 370 371 372 373 374 375 376 377
               Set_Str_To_Name_Buffer ("name");
               P := Make_Defining_Identifier (Name_Find);

               Get_Name_String (Display_Name (Identifier (F)));
               Q := Make_Defining_Identifier (To_Lower (Name_Find));
               Append_Node_To_List
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));

378
               Append_Node_To_List (Port_Node, XTN.Subitems (Port_Table_Node));
379 380 381 382 383 384 385
            end if;
            F := Next_Node (F);
         end loop;

         Append_Node_To_List (Port_Table_Node, XTN.Subitems (Partition_Node));
      end if;

386
      Append_Node_To_List (Partition_Node, XTN.Subitems (Current_XML_Node));
387 388 389 390 391 392 393
   end Visit_Process_Instance;

   ---------------------------
   -- Visit_System_Instance --
   ---------------------------

   procedure Visit_System_Instance (E : Node_Id) is
394 395 396
      S : Node_Id;
      U : Node_Id;
      R : Node_Id;
397 398 399 400
   begin
      U := XTN.Unit (Backend_Node (Identifier (E)));
      R := XTN.Node (Backend_Node (Identifier (E)));

401 402
      Current_System := E;

403 404 405 406 407 408 409 410
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));

      Push_Entity (U);
      Push_Entity (R);

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
411 412
            --  Visit the component instance corresponding to the
            --  subcomponent S.
413 414 415
            if AINU.Is_Processor (Corresponding_Instance (S)) then
               Visit (Corresponding_Instance (S));
            end if;
416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
            S := Next_Node (S);
         end loop;
      end if;

      Pop_Entity;
      Pop_Entity;
   end Visit_System_Instance;

   ------------------------------
   -- Visit_Processor_Instance --
   ------------------------------

   procedure Visit_Processor_Instance (E : Node_Id) is
      S                    : Node_Id;
      Partition_Table_Node : Node_Id;
   begin
      --  Create the main PartitionTable node.

      Partition_Table_Node := Make_XML_Node ("PartitionTable");

436 437 438
      Append_Node_To_List
        (Partition_Table_Node,
         XTN.Subitems (Current_XML_Node));
439

440 441 442 443 444
      Current_XML_Node := Partition_Table_Node;

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
445 446
            --  Visit the component instance corresponding to the
            --  subcomponent S.
447 448 449 450 451

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
452

453 454 455 456 457 458 459
   end Visit_Processor_Instance;

   --------------------------------------
   -- Visit_Virtual_Processor_Instance --
   --------------------------------------

   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
460
      S : Node_Id;
461
   begin
462 463 464
      if not AINU.Is_Empty (Subcomponents (Current_System)) then
         S := First_Node (Subcomponents (Current_System));
         while Present (S) loop
465 466 467 468 469
            --  Visit the component instance corresponding to the
            --  subcomponent S.
            if AINU.Is_Process (Corresponding_Instance (S))
              and then Get_Bound_Processor (Corresponding_Instance (S)) = E
            then
470 471 472 473 474 475
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;

476 477 478
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
479 480
            --  Visit the component instance corresponding to the
            --  subcomponent S.
481 482 483 484 485 486 487 488

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
   end Visit_Virtual_Processor_Instance;

end Ocarina.Backends.Xtratum_Conf.Partition_Table;