ocarina-backends-xtratum_conf-hardware_description.adb 17.2 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--           OCARINA.BACKENDS.XTRATUM_CONF.HARDWARE_DESCRIPTION             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
yoogx's avatar
yoogx committed
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

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

40 41
with Ocarina.Instances.Queries;

42
with Ocarina.Backends.Utils;
43
with Ocarina.Backends.Messages;
44
with Ocarina.Backends.Properties;
yoogx's avatar
yoogx committed
45
with Ocarina.Backends.Properties.ARINC653;
46 47 48 49 50 51 52 53 54
with Ocarina.Backends.XML_Values;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;

package body Ocarina.Backends.Xtratum_Conf.Hardware_Description is

   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
   use Ocarina.ME_AADL.AADL_Instances.Entities;
55 56 57

   use Ocarina.Instances.Queries;

58
   use Ocarina.Backends.Utils;
59
   use Ocarina.Backends.Messages;
60
   use Ocarina.Backends.Properties;
yoogx's avatar
yoogx committed
61
   use Ocarina.Backends.Properties.ARINC653;
62 63 64 65 66
   use Ocarina.Backends.XML_Values;
   use Ocarina.Backends.XML_Tree.Nutils;

   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
67
   package XV renames Ocarina.Backends.XML_Values;
68 69 70 71 72

   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);
73
   procedure Visit_Memory_Instance (E : Node_Id);
74 75 76
   procedure Visit_Processor_Instance (E : Node_Id);
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);

77
   Processor_Identifier : Unsigned_Long_Long := 0;
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 110

   -----------
   -- 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
111
      Category : constant Component_Category := Get_Category_Of_Component (E);
112 113 114 115 116 117 118 119 120 121 122
   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);

123 124 125
         when CC_Memory =>
            Visit_Memory_Instance (E);

126 127 128 129 130 131 132 133 134 135 136 137 138
         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
139
      pragma Unreferenced (E);
140
   begin
141
      null;
142 143 144 145 146 147 148
   end Visit_Process_Instance;

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

   procedure Visit_System_Instance (E : Node_Id) is
149 150 151
      S              : Node_Id;
      Hw_Desc_Node   : Node_Id;
      Processor_Node : Node_Id;
152
      Memory_Node    : Node_Id;
153
      Device_Node    : Node_Id;
154 155
      U              : Node_Id;
      R              : Node_Id;
156 157 158 159 160 161 162 163 164 165 166
   begin
      U := XTN.Unit (Backend_Node (Identifier (E)));
      R := XTN.Node (Backend_Node (Identifier (E)));

      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));

      Push_Entity (U);
      Push_Entity (R);

      Hw_Desc_Node := Make_XML_Node ("HwDescription");

167
      Append_Node_To_List (Hw_Desc_Node, XTN.Subitems (Current_XML_Node));
168

yoogx's avatar
yoogx committed
169 170
      --  First, create the <MemoryLayout> section of the hardware
      --  description of the system.
171

yoogx's avatar
yoogx committed
172
      Memory_Node := Make_XML_Node ("MemoryLayout");
173

yoogx's avatar
yoogx committed
174
      Append_Node_To_List (Memory_Node, XTN.Subitems (Hw_Desc_Node));
175

yoogx's avatar
yoogx committed
176
      Current_XML_Node := Memory_Node;
177

178 179 180
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
181 182
            --  Visit the component instance corresponding to the
            --  subcomponent S.
yoogx's avatar
yoogx committed
183
            if AINU.Is_Memory (Corresponding_Instance (S)) then
184 185 186 187 188
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;
189

yoogx's avatar
yoogx committed
190
      --  Then, create the <ProcessorTable> section of the hardware
191 192
      --  description of the system.

yoogx's avatar
yoogx committed
193
      Processor_Node := Make_XML_Node ("ProcessorTable");
194

yoogx's avatar
yoogx committed
195
      Append_Node_To_List (Processor_Node, XTN.Subitems (Hw_Desc_Node));
196

yoogx's avatar
yoogx committed
197
      Current_XML_Node := Processor_Node;
198 199 200 201

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
202 203
            --  Visit the component instance corresponding to the
            --  subcomponent S.
yoogx's avatar
yoogx committed
204
            if AINU.Is_Processor (Corresponding_Instance (S)) then
205 206 207 208 209 210
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;

211 212 213 214 215 216 217 218 219 220 221 222 223 224
      Device_Node := Make_XML_Node ("Devices");

      --  Automatically add an UART device for debugging purposes.
      declare
         Uart_Node : Node_Id;
         P         : Node_Id;
         Q         : Node_Id;
      begin
         Uart_Node := Make_XML_Node ("Uart");

         Set_Str_To_Name_Buffer ("id");
         P := Make_Defining_Identifier (Name_Find);
         Set_Str_To_Name_Buffer ("0");
         Q := Make_Defining_Identifier (Name_Find);
225
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Uart_Node));
226 227 228 229 230

         Set_Str_To_Name_Buffer ("baudRate");
         P := Make_Defining_Identifier (Name_Find);
         Set_Str_To_Name_Buffer ("115200");
         Q := Make_Defining_Identifier (Name_Find);
231
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Uart_Node));
232 233 234 235 236

         Set_Str_To_Name_Buffer ("name");
         P := Make_Defining_Identifier (Name_Find);
         Set_Str_To_Name_Buffer ("Uart");
         Q := Make_Defining_Identifier (Name_Find);
237
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Uart_Node));
238

239
         Append_Node_To_List (Uart_Node, XTN.Subitems (Device_Node));
240 241
      end;

242
      Append_Node_To_List (Device_Node, XTN.Subitems (Hw_Desc_Node));
243

244 245 246 247 248 249 250 251 252
      Pop_Entity;
      Pop_Entity;
   end Visit_System_Instance;

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

   procedure Visit_Processor_Instance (E : Node_Id) is
yoogx's avatar
yoogx committed
253 254 255 256 257 258 259 260 261 262 263 264 265
      S               : Node_Id;
      P               : Node_Id;
      Q               : Node_Id;
      Processor_Node  : Node_Id;
      Plan_Table_Node : Node_Id;
      Plan_Node       : Node_Id;
      Start_Time      : Unsigned_Long_Long := 0;
      Slot_Node       : Node_Id;
      Partition       : Node_Id;
      Slot_Identifier : Unsigned_Long_Long := 0;

      Module_Schedule : constant Schedule_Window_Record_Term_Array :=
        Get_Module_Schedule_Property (E);
yoogx's avatar
yoogx committed
266
      Frequency : constant Frequency_Type := Get_Processor_Frequency (E);
267
   begin
yoogx's avatar
yoogx committed
268
      if Module_Schedule'Length = 0 then
269 270 271 272
         Display_Error
           ("You must provide the slots allocation for each processor",
            Fatal => True);
      end if;
273

yoogx's avatar
yoogx committed
274 275
      --  First, add a <Processor> node, made of

276 277
      Processor_Node := Make_XML_Node ("Processor");

yoogx's avatar
yoogx committed
278 279
      --  a) processor id

280
      Set_Str_To_Name_Buffer ("id");
281
      P := Make_Defining_Identifier (Name_Find);
282
      Q := Make_Literal (XV.New_Numeric_Value (Processor_Identifier, 0, 10));
283 284

      Append_Node_To_List
285 286
        (Make_Assignement (P, Q),
         XTN.Items (Processor_Node));
287

yoogx's avatar
yoogx committed
288 289
      --  b) processor frequency

290 291 292
      Set_Str_To_Name_Buffer ("frequency");
      P := Make_Defining_Identifier (Name_Find);

yoogx's avatar
yoogx committed
293
      Set_Str_To_Name_Buffer
yoogx's avatar
yoogx committed
294
        (Unsigned_Long_Long'Image (Frequency.S) & "MHz");
yoogx's avatar
yoogx committed
295
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
296 297

      Append_Node_To_List
298 299
        (Make_Assignement (P, Q),
         XTN.Items (Processor_Node));
300 301 302 303 304 305 306 307 308 309 310

      --  Within the <processor/> node, add a <CyclicPlanTable/>
      --  node.
      Plan_Table_Node := Make_XML_Node ("CyclicPlanTable");
      Append_Node_To_List (Plan_Table_Node, XTN.Subitems (Processor_Node));

      --  Then, describe the scheduling plan for this node.
      --  At this time, we support only one plan for each processor.
      Plan_Node := Make_XML_Node ("Plan");
      Append_Node_To_List (Plan_Node, XTN.Subitems (Plan_Table_Node));

yoogx's avatar
yoogx committed
311 312 313
      --  XXX by default, we map just one plan. We may support multiple
      --  plans, one per mode.

314 315 316
      Set_Str_To_Name_Buffer ("id");
      P := Make_Defining_Identifier (Name_Find);
      Q := Make_Literal (XV.New_Numeric_Value (0, 0, 10));
317

318
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Plan_Node));
319 320 321 322 323

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

      Set_Str_To_Name_Buffer
324
        (Unsigned_Long_Long'Image (To_Milliseconds (Get_POK_Major_Frame (E))));
325
      Add_Str_To_Name_Buffer ("ms");
326
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
327

328
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Plan_Node));
329 330 331 332

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

yoogx's avatar
yoogx committed
333 334
      for J in Module_Schedule'Range loop
         Partition := Module_Schedule (J).Partition;
335

336 337 338 339 340 341 342 343 344
         --  Create the node that corresponds to the slot.

         Slot_Node := Make_XML_Node ("Slot");

         --  Associate a fixed identifier to the slot.

         Set_Str_To_Name_Buffer ("id");
         P := Make_Defining_Identifier (Name_Find);
         Q := Make_Literal (XV.New_Numeric_Value (Slot_Identifier, 0, 10));
345
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
346

yoogx's avatar
yoogx committed
347 348
         --  Define the start attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("start");
349
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
350 351 352
         Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Start_Time));
         Add_Str_To_Name_Buffer ("ms");
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
353
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
354 355 356 357

         --  Define the duration attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("duration");
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
358

359
         Set_Str_To_Name_Buffer
yoogx's avatar
yoogx committed
360 361
           (Unsigned_Long_Long'Image
              (To_Milliseconds (Module_Schedule (J).Duration)));
362
         Add_Str_To_Name_Buffer ("ms");
363
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
364
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
365

yoogx's avatar
yoogx committed
366 367 368 369 370 371 372 373 374 375 376 377 378
         --  Associate a fixed identifier to the slot.
         if not AINU.Is_Empty (Subcomponents (E)) then
            S := First_Node (Subcomponents (E));
            while Present (S) loop
               if Corresponding_Declaration (S) =
                 Module_Schedule (J).Partition
               then
                  Partition := Corresponding_Instance (S);
               end if;
               S := Next_Node (S);
            end loop;
         end if;
         Set_Str_To_Name_Buffer ("partitionId");
379
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
380 381 382 383 384 385 386

         Q :=
           Make_Literal
             (XV.New_Numeric_Value
                (Get_Partition_Identifier (Partition),
                 0,
                 10));
387
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
388 389 390 391 392

         Append_Node_To_List (Slot_Node, XTN.Subitems (Plan_Node));

         Slot_Identifier := Slot_Identifier + 1;

yoogx's avatar
yoogx committed
393 394
         Start_Time :=
           Start_Time + To_Milliseconds (Module_Schedule (J).Duration);
395 396

      end loop;
397 398 399 400

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
401 402
            --  Visit the component instance corresponding to the
            --  subcomponent S.
403 404 405 406 407

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

      Processor_Identifier := Processor_Identifier + 1;

      Append_Node_To_List (Processor_Node, XTN.Subitems (Current_XML_Node));
412 413 414 415 416 417 418
   end Visit_Processor_Instance;

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

   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
419
      S : Node_Id;
420 421 422 423
   begin
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
424 425
            --  Visit the component instance corresponding to the
            --  subcomponent S.
426 427 428 429 430 431 432

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

433 434 435 436 437
   ---------------------------
   -- Visit_Memory_Instance --
   ---------------------------

   procedure Visit_Memory_Instance (E : Node_Id) is
438 439 440 441 442
      P                  : Node_Id;
      Q                  : Node_Id;
      Memory_Node        : Node_Id;
      Base_Address_Value : Unsigned_Long_Long;
      Byte_Count_Value   : Unsigned_Long_Long;
443 444 445 446
   begin
      Memory_Node := Make_XML_Node ("Region");

      --  Add the start attribute of the region node.
447
      Base_Address_Value := Get_Integer_Property (E, "base_address");
448
      Byte_Count_Value   := Get_Integer_Property (E, "byte_count");
449 450 451

      if Base_Address_Value = 0 or else Byte_Count_Value = 0 then
         Display_Located_Error
452 453 454 455
           (Loc (E),
            "Memory does not specify the byte_count " &
            "or base_address properties (not fatal)",
            Fatal => False);
456 457 458
         return;
      end if;

459 460
      Set_Str_To_Name_Buffer ("start");
      P := Make_Defining_Identifier (Name_Find);
461
      Set_Str_To_Name_Buffer ("0x");
462
      Add_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Base_Address_Value));
463 464

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

466
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
467 468 469 470

      --  Add the size attribute of the region node.
      Set_Str_To_Name_Buffer ("size");
      P := Make_Defining_Identifier (Name_Find);
471
      Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Byte_Count_Value));
472 473
      Add_Str_To_Name_Buffer ("B");
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
474

475
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
476 477 478 479 480 481 482

      --  Add the type attribute of the region node.
      Set_Str_To_Name_Buffer ("type");
      P := Make_Defining_Identifier (Name_Find);
      Set_Str_To_Name_Buffer ("stram");
      Q := Make_Defining_Identifier (Name_Find);

483
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
484 485 486 487

      Append_Node_To_List (Memory_Node, XTN.Subitems (Current_XML_Node));
   end Visit_Memory_Instance;

488
end Ocarina.Backends.Xtratum_Conf.Hardware_Description;