ocarina-backends-cheddar-mapping.adb 26 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--     O C A R I N A . B A C K E N D S . C H E D D A R . M A P P I N G      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--                   Copyright (C) 2010-2017 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
--                                                                          --
------------------------------------------------------------------------------

yoogx's avatar
yoogx committed
32 33 34
with GNAT.OS_Lib;   use GNAT.OS_Lib;
with Ocarina.Namet; use Ocarina.Namet;
with Utils;         use Utils;
35 36 37 38 39

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

40
with Ocarina.Backends.Build_Utils;
41
with Ocarina.Backends.Messages;
42 43 44 45 46 47 48 49 50 51 52 53 54
with Ocarina.Backends.Properties;
with Ocarina.Backends.Utils;
with Ocarina.Backends.XML_Common.Mapping;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
with Ocarina.Backends.XML_Values;

package body Ocarina.Backends.Cheddar.Mapping is

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

55
   use Ocarina.Backends.Build_Utils;
56
   use Ocarina.Backends.Messages;
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
   use Ocarina.Backends.Properties;
   use Ocarina.Backends.Utils;
   use Ocarina.Backends.XML_Common.Mapping;
   use Ocarina.Backends.XML_Tree.Nodes;
   use Ocarina.Backends.XML_Tree.Nutils;

   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;
   package XV renames Ocarina.Backends.XML_Values;

   function Map_Buffer_Name (E : Node_Id; P : Node_Id) return Name_Id;
   --  Compute name of buffer by concatenating name of the thread
   --  instance and name of the port.

   ---------------------
   -- Map_Buffer_Name --
   ---------------------

   function Map_Buffer_Name (E : Node_Id; P : Node_Id) return Name_Id is
   begin
      Get_Name_String (Display_Name (Identifier (Parent_Subcomponent (E))));
      Add_Str_To_Name_Buffer ("_");
      Get_Name_String_And_Append (Display_Name (Identifier (P)));
      return To_Lower (Name_Find);
   end Map_Buffer_Name;

   -----------------
   -- Map_HI_Node --
   -----------------

   function Map_HI_Node (E : Node_Id) return Node_Id is
      N : constant Node_Id := New_Node (XTN.K_HI_Node);
   begin
91 92 93 94
      pragma Assert
        (AINU.Is_Process (E)
         or else AINU.Is_System (E)
         or else AINU.Is_Processor (E));
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

      if AINU.Is_System (E) then
         Set_Str_To_Name_Buffer ("general");
      else
         Get_Name_String
           (To_XML_Name (AIN.Name (Identifier (Parent_Subcomponent (E)))));
         Add_Str_To_Name_Buffer ("_cheddar");
      end if;

      XTN.Set_Name (N, Name_Find);
      Set_Units (N, New_List (K_List_Id));

      --  Append the partition N to the node list

      Append_Node_To_List (N, HI_Nodes (Current_Entity));
      Set_Distributed_Application (N, Current_Entity);

      return N;
   end Map_HI_Node;

   -----------------
   -- Map_HI_Unit --
   -----------------

119 120 121 122 123 124
   function Map_HI_Unit (E : Node_Id) return Node_Id is
      U    : Node_Id;
      N    : Node_Id;
      P    : Node_Id;
      Root : Node_Id;
      DTD  : Node_Id;
125
   begin
126 127 128 129
      pragma Assert
        (AINU.Is_System (E)
         or else AINU.Is_Process (E)
         or else AINU.Is_Processor (E));
130 131 132 133 134 135 136 137 138 139

      U := New_Node (XTN.K_HI_Unit, Identifier (E));

      --  Packages that are common to all nodes

      if AINU.Is_System (E) then
         Get_Name_String (To_XML_Name (Display_Name (Identifier (E))));

      else
         Get_Name_String
140
           (To_XML_Name (Display_Name (Identifier (Parent_Subcomponent (E)))));
141 142 143 144
      end if;

      Add_Str_To_Name_Buffer ("_cheddar");
      N := Make_Defining_Identifier (Name_Find);
145 146

      Set_Str_To_Name_Buffer
147
        (Get_Runtime_Path ("cheddar") & Directory_Separator & "cheddar.dtd");
148 149 150
      DTD := Make_Defining_Identifier (Name_Find);

      P := Make_XML_File (N, DTD);
151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
      Set_Distributed_Application_Unit (P, U);
      XTN.Set_XML_File (U, P);

      Root := Make_XML_Node ("", No_Name, K_Nameid);

      XTN.Set_Root_Node (P, Root);

      Append_Node_To_List (U, Units (Current_Entity));
      XTN.Set_Entity (U, Current_Entity);

      return U;
   end Map_HI_Unit;

   -------------------
   -- Map_Processor --
   -------------------

   function Map_Processor (E : Node_Id) return Node_Id is
      N : Node_Id;
      P : Node_Id;

172 173
      Schedulers : constant array
      (Supported_Scheduling_Protocol'Range) of Name_Id :=
174 175 176 177 178 179
        (RATE_MONOTONIC_PROTOCOL =>
           Get_String_Name ("RATE_MONOTONIC_PROTOCOL"),
         POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL =>
           Get_String_Name ("POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL"),
         EARLIEST_DEADLINE_FIRST_PROTOCOL =>
           Get_String_Name ("EARLIEST_DEADLINE_FIRST_PROTOCOL"),
180 181
         ROUND_ROBIN_PROTOCOL => Get_String_Name ("ROUND_ROBIN_PROTOCOL"),
         others               => No_Name);
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197

      Quantum : constant Time_Type := Get_Scheduler_Quantum (E);
   begin
      --  The structure of a XML node for a processor is
      --  <!ELEMENT processor (name|
      --                       scheduler|
      --                       network_link)
      --  >

      N := Make_XML_Node ("processor");

      --  name: computed from processor instance name
      P := Map_Node_Identifier_To_XML_Node ("name", Parent_Subcomponent (E));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  scheduler: computed from Scheduling_Protocol policy
198 199 200 201
      P :=
        Map_To_XML_Node
          ("scheduler",
           Schedulers (Get_Scheduling_Protocol (E)));
202 203

      --  quantum: XXX use default value
204 205
      if Quantum /= Null_Time then
         declare
206 207 208 209
            Name : constant Node_Id :=
              Make_Defining_Identifier (Get_String_Name ("quantum"));
            Value : constant Node_Id :=
              Make_Literal
210
                (XV.New_Numeric_Value (To_Microseconds (Quantum), 1, 10));
211
         begin
212 213 214
            Append_Node_To_List
              (Make_Assignement (Name, Value),
               XTN.Items (P));
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
         end;
      end if;

      Append_Node_To_List (P, XTN.Subitems (N));

      --  network_link: XXX for now we put a default value
      P := Map_To_XML_Node ("network_link", Get_String_Name ("No_Network"));
      Append_Node_To_List (P, XTN.Subitems (N));

      return N;
   end Map_Processor;

   --------------
   -- Map_Data --
   --------------

   function Map_Data (E : Node_Id) return Node_Id is
      N : Node_Id;
      P : Node_Id;

      Concurrency_Protocols : constant array
236
      (Supported_Concurrency_Control_Protocol'Range) of Name_Id :=
yoogx's avatar
yoogx committed
237 238 239
        (None_Specified   => Get_String_Name ("NO_PROTOCOL"),
         Priority_Ceiling => Get_String_Name ("PRIORITY_CEILING_PROTOCOL"),
         others           => No_Name);
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255

   begin
      --  The structure of a XML node for a data is
      --  <!ELEMENT resource (cpu_name|
      --                      address_space_name|
      --                      name|
      --                      state|
      --                      protocol|
      --                      (state)?|
      --                      (resource_used_by)?)
      --  >

      N := Make_XML_Node ("resource");

      --  cpu_name: computed from the processor binding of the
      --  container process of the current data
256 257 258 259 260 261 262
      P :=
        Map_Node_Identifier_To_XML_Node
          ("cpu_name",
           Parent_Subcomponent
             (Get_Bound_Processor
                (Corresponding_Instance
                   (Get_Container_Process (Parent_Subcomponent (E))))));
263 264 265
      Append_Node_To_List (P, XTN.Subitems (N));

      --  address_space: name of the enclosing process
266 267 268 269
      P :=
        Map_Node_Identifier_To_XML_Node
          ("address_space_name",
           Get_Container_Process (Parent_Subcomponent (E)));
270 271 272 273 274 275 276 277 278 279 280
      Append_Node_To_List (P, XTN.Subitems (N));

      --  name: computed from data instance name
      P := Map_Node_Identifier_To_XML_Node ("name", Parent_Subcomponent (E));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  state: XXX ?
      P := Map_To_XML_Node ("state", Unsigned_Long_Long'(1));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  protocol: computed from Concurrency_Protocol property
281 282 283 284
      P :=
        Map_To_XML_Node
          ("protocol",
           Concurrency_Protocols (Get_Concurrency_Protocol (E)));
285 286 287 288 289 290 291 292
      Append_Node_To_List (P, XTN.Subitems (N));

      --  resource_used_by: computed from the list of threads
      --  accessing to this data component. Per construction, it is
      --  assumed to be computed from the list of connections in the
      --  enclosing process.
      P := Make_XML_Node ("resource_used_by");
      declare
293 294 295 296
         Access_List : constant List_Id :=
           Connections
             (Corresponding_Instance
                (Get_Container_Process (Parent_Subcomponent (E))));
297
         Connection : Node_Id;
298
         K, M       : Node_Id;
299 300 301 302 303
      begin
         if not AINU.Is_Empty (Access_List) then
            Connection := AIN.First_Node (Access_List);
            while Present (Connection) loop
               if Kind (Connection) = K_Connection_Instance
304 305 306
                 and then
                   Get_Category_Of_Connection (Connection) =
                   CT_Access_Data
307
               then
308 309
                  if Item (AIN.First_Node (Path (Source (Connection)))) =
                    Parent_Subcomponent (E)
310 311
                  then
                     M := Make_XML_Node ("resource_user");
312 313 314 315 316 317 318
                     K :=
                       Make_Defining_Identifier
                         (Fully_Qualified_Instance_Name
                            (Corresponding_Instance
                               (Item
                                  (AIN.First_Node
                                     (Path (Destination (Connection)))))));
319
                     Append_Node_To_List (K, XTN.Subitems (M));
320 321 322 323 324

                     --  For now, we assume all tasks take the
                     --  resource at the beginning, and release it at
                     --  the end of their dispatch.

325
                     K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
326
                     Append_Node_To_List (K, XTN.Subitems (M));
327 328 329
                     K :=
                       Make_Literal
                         (XV.New_Numeric_Value
330
                            (To_Microseconds
331 332 333 334 335 336 337 338
                               (Get_Execution_Time
                                  (Corresponding_Instance
                                     (Item
                                        (AIN.First_Node
                                           (Path (Destination (Connection))))))
                                  (1)),
                             1,
                             10));
339
                     Append_Node_To_List (K, XTN.Subitems (M));
340

341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
                     Append_Node_To_List (M, XTN.Subitems (P));
                  end if;
               end if;
               Connection := AIN.Next_Node (Connection);
            end loop;
         end if;
      end;

      Append_Node_To_List (P, XTN.Subitems (N));

      return N;
   end Map_Data;

   -----------------
   -- Map_Process --
   -----------------

   function Map_Process (E : Node_Id) return Node_Id is
      N : Node_Id;
      P : Node_Id;
   begin
      --  The structure of a XML node for a address_space is
      --  <!ELEMENT address_space (name|
      --                           text_memory_size|
      --                           data_memory_size|
      --                           stack_memory_size|
      --                           heap_memory_size)
      --  >

      N := Make_XML_Node ("address_space");

      --  name: computed from process instance name
373 374 375 376
      P :=
        Map_Node_Identifier_To_XML_Node
          ("name",
           Fully_Qualified_Instance_Name (E));
377 378 379 380
      Append_Node_To_List (P, XTN.Subitems (N));

      --  cpu_name: computed from the processor binding of the
      --  container process of the current thread
381 382 383 384
      P :=
        Map_Node_Identifier_To_XML_Node
          ("cpu_name",
           Parent_Subcomponent (Get_Bound_Processor (E)));
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
      Append_Node_To_List (P, XTN.Subitems (N));

      --  text_memory_size: XXX
      P := Map_To_XML_Node ("text_memory_size", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  data_memory_size: XXX
      P := Map_To_XML_Node ("data_memory_size", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  stack_memory_size: XXX
      P := Map_To_XML_Node ("stack_memory_size", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  heap_memory_size: XXX
      P := Map_To_XML_Node ("heap_memory_size", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      return N;
   end Map_Process;

   ----------------
   -- Map_Thread --
   ----------------

   function Map_Thread (E : Node_Id) return Node_Id is
411
      N, P  : Node_Id;
412
      Value : Node_Id;
413
      Name  : Node_Id;
414 415

      Dispatch_Protocols : constant array
416
      (Supported_Thread_Dispatch_Protocol'Range) of Name_Id :=
417 418
        (Thread_Sporadic => Get_String_Name ("SPORADIC_TYPE"),
         Thread_Periodic => Get_String_Name ("PERIODIC_TYPE"),
419
         others          => No_Name);
420 421

      POSIX_Policies : constant array
422 423
      (Supported_POSIX_Scheduling_Policy'Range) of Name_Id :=
        (SCHED_FIFO   => Get_String_Name ("SCHED_FIFO"),
424
         SCHED_OTHERS => Get_String_Name ("SCHED_OTHERS"),
425 426
         SCHED_RR     => Get_String_Name ("SCHED_RR"),
         None         => No_Name);
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460

      Dispatch : constant Supported_Thread_Dispatch_Protocol :=
        Get_Thread_Dispatch_Protocol (E);

      POSIX_Policy : constant Supported_POSIX_Scheduling_Policy :=
        Get_Thread_POSIX_Scheduling_Policy (E);

   begin
      --  The structure of a XML node for a task is
      --  <!ELEMENT task (name|
      --                  cpu_name|
      --                  address_space_name|
      --                  capacity|
      --                  start_time|
      --                  (stack_memory_size)?|
      --                  (text_memory_size)?|
      --                  (period)?|
      --                  (deadline)?|
      --                  (parameters)?|
      --                  (offsets)?|
      --                  (jitter)?|
      --                  (policy)?|
      --                  (priority)?|
      --                  (predictable_seed)?|
      --                  (blocking_time)?|
      --                  (seed)?|
      --                  (activation_rule)?)
      --  >

      N := Make_XML_Node ("task");

      --  task_type attribute
      --   supported values are PERIODIC or SPORADIC

461 462
      if Dispatch = Thread_Sporadic or else Dispatch = Thread_Periodic then
         Name  := Make_Defining_Identifier (Get_String_Name ("task_type"));
463
         Value := Make_Defining_Identifier (Dispatch_Protocols (Dispatch));
464
         Append_Node_To_List (Make_Assignement (Name, Value), XTN.Items (N));
465 466 467 468
      end if;

      --  cpu_name: computed from the processor binding of the
      --  container process of the current thread
469 470 471 472 473 474 475
      P :=
        Map_Node_Identifier_To_XML_Node
          ("cpu_name",
           Parent_Subcomponent
             (Get_Bound_Processor
                (Corresponding_Instance
                   (Get_Container_Process (Parent_Subcomponent (E))))));
476 477 478
      Append_Node_To_List (P, XTN.Subitems (N));

      --  address_space: name of the enclosing process
479 480 481 482 483 484
      P :=
        Map_Node_Identifier_To_XML_Node
          ("address_space_name",
           Fully_Qualified_Instance_Name
             (Corresponding_Instance
                (Get_Container_Process (Parent_Subcomponent (E)))));
485 486 487
      Append_Node_To_List (P, XTN.Subitems (N));

      --  name: computed from thread instance name
488 489 490 491
      P :=
        Map_Node_Identifier_To_XML_Node
          ("name",
           Fully_Qualified_Instance_Name (E));
492 493 494 495
      Append_Node_To_List (P, XTN.Subitems (N));

      --  capacity: computed from the Compute_Execution_Time property
      --  XXX for now, we take the first value
496 497 498 499
      if Get_Execution_Time (E) = Empty_Time_Array then
         Display_Located_Error
           (AIN.Loc (E),
            "Property Compute_Exeuction_Time not set," &
500 501 502
            " assuming default value of 0",
            Fatal   => False,
            Warning => True);
503 504 505

         P := Map_To_XML_Node ("capacity", Unsigned_Long_Long'(0));
      else
506 507 508
         P :=
           Map_To_XML_Node
             ("capacity",
509
              To_Microseconds (Get_Execution_Time (E) (1)));
510
      end if;
511 512 513
      Append_Node_To_List (P, XTN.Subitems (N));

      --  start_time: computed from First_Dispatch_Time property, XXX units
514 515 516
      P :=
        Map_To_XML_Node
          ("start_time",
517
           To_Microseconds (Get_Thread_First_Dispatch_Time (E)));
518 519 520 521 522 523 524 525 526 527
      Append_Node_To_List (P, XTN.Subitems (N));

      --  policy: computed from the POSIX_Scheduling_Policy properties
      if POSIX_Policy /= None then
         P := Map_To_XML_Node ("policy", POSIX_Policies (POSIX_Policy));
         Append_Node_To_List (P, XTN.Subitems (N));
      end if;

      if Dispatch = Thread_Periodic or else Dispatch = Thread_Sporadic then
         --  deadline: computed from Deadline property, XXX check units
528 529 530
         P :=
           Map_To_XML_Node
             ("deadline",
531
              To_Microseconds (Get_Thread_Deadline (E)));
532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547
         Append_Node_To_List (P, XTN.Subitems (N));
      end if;

      --  blocking_time: XXX
      P := Map_To_XML_Node ("blocking_time", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  priority: computed from Priority property
      P := Map_To_XML_Node ("priority", Get_Thread_Priority (E));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  text_memory_size: XXX
      P := Map_To_XML_Node ("text_memory_size", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      --  stack_memory_size: computed from Source_Stack_Size property
548 549 550 551
      P :=
        Map_To_XML_Node
          ("stack_memory_size",
           To_Bytes (Get_Thread_Stack_Size (E)));
552 553 554 555
      Append_Node_To_List (P, XTN.Subitems (N));

      if Dispatch = Thread_Periodic or else Dispatch = Thread_Sporadic then
         --  period: computed from Period property, XXX check units
556
         P :=
557
           Map_To_XML_Node ("period", To_Microseconds (Get_Thread_Period (E)));
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588
         Append_Node_To_List (P, XTN.Subitems (N));
      end if;

      --  jitter: XXX
      P := Map_To_XML_Node ("jitter", Unsigned_Long_Long'(0));
      Append_Node_To_List (P, XTN.Subitems (N));

      return N;
   end Map_Thread;

   ----------------
   -- Map_Buffer --
   ----------------

   function Map_Buffer (E : Node_Id; P : Node_Id) return Node_Id is
      N : Node_Id;
      K : Node_Id;
   begin
      --  The structure of a XML node for a buffer is
      --  <!ELEMENT buffer (cpu_name|
      --                    address_space_name|
      --                    qs|
      --                    name|
      --                    size|
      --                    (buffer_used_by)?)
      --  >

      N := Make_XML_Node ("buffer");

      --  cpu_name: computed from the processor binding of the
      --  container process of the current thread
589 590 591 592 593 594 595
      K :=
        Map_Node_Identifier_To_XML_Node
          ("cpu_name",
           Parent_Subcomponent
             (Get_Bound_Processor
                (Corresponding_Instance
                   (Get_Container_Process (Parent_Subcomponent (E))))));
596 597 598
      Append_Node_To_List (K, XTN.Subitems (N));

      --  address_space: name of the enclosing process
599 600 601 602
      K :=
        Map_Node_Identifier_To_XML_Node
          ("address_space_name",
           Get_Container_Process (Parent_Subcomponent (E)));
603 604 605 606 607 608 609
      Append_Node_To_List (K, XTN.Subitems (N));

      --  qs: XXX
      K := Map_To_XML_Node ("qs", Get_String_Name ("QS_PP1"));
      Append_Node_To_List (K, XTN.Subitems (N));

      --  name: computed from thread instance name + port_name
610
      K := Map_To_XML_Node ("name", Map_Buffer_Name (E, P));
611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642
      Append_Node_To_List (K, XTN.Subitems (N));

      --  size: computed from the queue size
      declare
         Size : Long_Long := Get_Queue_Size (P);
      begin
         if Size = -1 then
            Size := 1;
         end if;
         K := Map_To_XML_Node ("size", Unsigned_Long_Long (Size));
         Append_Node_To_List (K, XTN.Subitems (N));
      end;

      --  buffer_used_by
      declare
         L : Node_Id;
         M : Node_Id;
      begin
         --  This node list all users of a particular buffer attached
         --  to the P in event (data) port.

         L := Make_XML_Node ("buffer_used_by");

         --  The current thread is a consumer of the buffer associated
         --  to the P in event (data) port.

         M := Make_XML_Node ("buffer_user");
         Append_Node_To_List
           (Make_Assignement
              (Make_Defining_Identifier (Get_String_Name ("buffer_role")),
               Make_Defining_Identifier (Get_String_Name ("consumer"))),
            XTN.Items (M));
643
         K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
644 645 646 647 648 649 650 651 652 653 654
         Append_Node_To_List (K, XTN.Subitems (M));
         K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
         Append_Node_To_List (K, XTN.Subitems (M));
         K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
         Append_Node_To_List (K, XTN.Subitems (M));
         Append_Node_To_List (M, XTN.Subitems (L));

         --  Threads connected to the P in event (data) port are producers

         declare
            List_Sources : constant List_Id := Get_Source_Ports (P);
655
            Z            : Node_Id;
656 657 658 659 660
         begin
            if not AINU.Is_Empty (List_Sources) then
               Z := AIN.First_Node (List_Sources);
               while Present (Z) loop
                  M := Make_XML_Node ("buffer_user");
661 662 663 664
                  K :=
                    Make_Defining_Identifier
                      (Fully_Qualified_Instance_Name
                         (Parent_Component (Item (Z))));
665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702
                  Append_Node_To_List (K, XTN.Subitems (M));
                  K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
                  Append_Node_To_List (K, XTN.Subitems (M));
                  K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
                  Append_Node_To_List (K, XTN.Subitems (M));
                  Append_Node_To_List (M, XTN.Subitems (L));

                  Z := AIN.Next_Node (Z);
               end loop;
            end if;
            Append_Node_To_List (L, XTN.Subitems (N));
         end;
      end;

      return N;
   end Map_Buffer;

   --------------------
   -- Map_Dependency --
   --------------------

   function Map_Dependency (E : Node_Id; P : Node_Id) return Node_Id is
      N : Node_Id;
      K : Node_Id;
   begin
      --  The structure of a XML node for a dependency is
      --  XXX

      N := Make_XML_Node ("dependency");

      if Is_In (P) then
         Append_Node_To_List
           (Make_Assignement
              (Make_Defining_Identifier (Get_String_Name ("from_type")),
               Make_Defining_Identifier (Get_String_Name ("buffer"))),
            XTN.Items (N));
         K := Make_Defining_Identifier (Map_Buffer_Name (E, P));
         Append_Node_To_List (K, XTN.Subitems (N));
703
         K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
704 705
         Append_Node_To_List (K, XTN.Subitems (N));

706 707 708 709 710 711 712 713 714
      else
         if Present (AIN.First_Node (Get_Destination_Ports (P))) then
            --  We have to defends against the destination being an empty list.

            Append_Node_To_List
              (Make_Assignement
                 (Make_Defining_Identifier (Get_String_Name ("to_type")),
                  Make_Defining_Identifier (Get_String_Name ("buffer"))),
               XTN.Items (N));
715
            K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
716
            Append_Node_To_List (K, XTN.Subitems (N));
717 718 719 720 721 722
            K :=
              Make_Defining_Identifier
                (Map_Buffer_Name
                   (Parent_Component
                      (Item (AIN.First_Node (Get_Destination_Ports (P)))),
                    Item (AIN.First_Node (Get_Destination_Ports (P)))));
723 724 725

            Append_Node_To_List (K, XTN.Subitems (N));
         end if;
726 727 728 729 730 731
      end if;

      return N;
   end Map_Dependency;

end Ocarina.Backends.Cheddar.Mapping;