OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--     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      --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2010-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 GNAT.OS_Lib;   use GNAT.OS_Lib;
33
with Ocarina.Namet; use Ocarina.Namet;
34
with Utils;         use Utils;
35

36
with Ocarina.ME_AADL.AADL_Instances.Entities;
37

38
with Ocarina.Backends.Build_Utils;
39
with Ocarina.Backends.Messages;
40
with Ocarina.Backends.XML_Common.Mapping;
41
with Ocarina.Backends.XML_Tree.Nodes;
42
with Ocarina.Backends.XML_Tree.Nutils;
43
with Ocarina.Backends.XML_Values;
44

45
package body Ocarina.Backends.Cheddar.Mapping is
46

47
   use Ocarina.ME_AADL.AADL_Instances.Entities;
48

49
   use Ocarina.Backends.Build_Utils;
50
   use Ocarina.Backends.Messages;
51
   use Ocarina.Backends.XML_Common.Mapping;
52
   use Ocarina.Backends.XML_Tree.Nodes;
53
   use Ocarina.Backends.XML_Tree.Nutils;
54

55
   --   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
56
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
57
   package XV renames Ocarina.Backends.XML_Values;
58

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

63
   ---------------------
64
   -- Map_Buffer_Name --
65
   ---------------------
66

67 1
   function Map_Buffer_Name (E : Node_Id; P : Node_Id) return Name_Id is
68
   begin
69 1
      Get_Name_String (Display_Name (Identifier (Parent_Subcomponent (E))));
70 1
      Add_Str_To_Name_Buffer ("_");
71 1
      Get_Name_String_And_Append (Display_Name (Identifier (P)));
72 1
      return To_Lower (Name_Find);
73
   end Map_Buffer_Name;
74

75
   -----------------
76
   -- Map_HI_Node --
77
   -----------------
78

79 1
   function Map_HI_Node (E : Node_Id) return Node_Id is
80 1
      N : constant Node_Id := New_Node (XTN.K_HI_Node);
81
   begin
82
      pragma Assert
83 1
        (AINU.Is_Process (E)
84 1
         or else AINU.Is_System (E)
85 0
         or else AINU.Is_Processor (E));
86

87 1
      if AINU.Is_System (E) then
88 1
         Set_Str_To_Name_Buffer ("general");
89
      else
90 0
         Get_Name_String
91 0
           (To_XML_Name (AIN.Name (Identifier (Parent_Subcomponent (E)))));
92 0
         Add_Str_To_Name_Buffer ("_cheddar");
93
      end if;
94

95 1
      XTN.Set_Name (N, Name_Find);
96 1
      Set_Units (N, New_List (K_List_Id));
97

98
      --  Append the partition N to the node list
99

100 1
      Append_Node_To_List (N, HI_Nodes (Current_Entity));
101 1
      Set_Distributed_Application (N, Current_Entity);
102

103 1
      return N;
104
   end Map_HI_Node;
105

106
   -----------------
107
   -- Map_HI_Unit --
108
   -----------------
109

110 1
   function Map_HI_Unit (E : Node_Id) return Node_Id is
111 1
      U    : Node_Id;
112 1
      N    : Node_Id;
113 1
      P    : Node_Id;
114 1
      Root : Node_Id;
115 1
      DTD  : Node_Id;
116
   begin
117
      pragma Assert
118 1
        (AINU.Is_System (E)
119 0
         or else AINU.Is_Process (E)
120 0
         or else AINU.Is_Processor (E));
121

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

124
      --  Packages that are common to all nodes
125

126 1
      if AINU.Is_System (E) then
127 1
         Get_Name_String (To_XML_Name (Display_Name (Identifier (E))));
128

129
      else
130 0
         Get_Name_String
131 0
           (To_XML_Name (Display_Name (Identifier (Parent_Subcomponent (E)))));
132
      end if;
133

134 1
      Add_Str_To_Name_Buffer ("_cheddar");
135 1
      N := Make_Defining_Identifier (Name_Find);
136

137 1
      Set_Str_To_Name_Buffer
138 1
        (Get_Runtime_Path ("cheddar") & Directory_Separator & "cheddar.dtd");
139 1
      DTD := Make_Defining_Identifier (Name_Find);
140

141 1
      P := Make_XML_File (N, DTD);
142 1
      Set_Distributed_Application_Unit (P, U);
143 1
      XTN.Set_XML_File (U, P);
144

145 1
      Root := Make_XML_Node ("", No_Name, K_Nameid);
146

147 1
      XTN.Set_Root_Node (P, Root);
148

149 1
      Append_Node_To_List (U, Units (Current_Entity));
150 1
      XTN.Set_Entity (U, Current_Entity);
151

152 1
      return U;
153
   end Map_HI_Unit;
154

155
   -------------------
156
   -- Map_Processor --
157
   -------------------
158

159 1
   function Map_Processor (E : Node_Id) return Node_Id is
160 1
      N : Node_Id;
161 1
      P : Node_Id;
162

163
      Schedulers : constant array
164
      (Supported_Scheduling_Protocol'Range) of Name_Id :=
165 1
        (RATE_MONOTONIC_PROTOCOL =>
166 1
           Get_String_Name ("RATE_MONOTONIC_PROTOCOL"),
167
         POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL =>
168 1
           Get_String_Name ("POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL"),
169
         EARLIEST_DEADLINE_FIRST_PROTOCOL =>
170 1
           Get_String_Name ("EARLIEST_DEADLINE_FIRST_PROTOCOL"),
171 1
         ROUND_ROBIN_PROTOCOL => Get_String_Name ("ROUND_ROBIN_PROTOCOL"),
172
         others               => No_Name);
173

174 1
      Quantum : constant Time_Type := Get_Scheduler_Quantum (E);
175
   begin
176
      --  The structure of a XML node for a processor is
177
      --  <!ELEMENT processor (name|
178
      --                       scheduler|
179
      --                       network_link)
180
      --  >
181

182 1
      N := Make_XML_Node ("processor");
183

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

188
      --  scheduler: computed from Scheduling_Protocol policy
189
      P :=
190 1
        Map_To_XML_Node
191
          ("scheduler",
192 1
           Schedulers (Get_Scheduling_Protocol (E)));
193

194
      --  quantum: XXX use default value
195 1
      if Quantum /= Null_Time then
196
         declare
197
            Name : constant Node_Id :=
198 1
              Make_Defining_Identifier (Get_String_Name ("quantum"));
199
            Value : constant Node_Id :=
200 1
              Make_Literal
201 1
                (XV.New_Numeric_Value (To_Microseconds (Quantum), 1, 10));
202
         begin
203 1
            Append_Node_To_List
204 1
              (Make_Assignement (Name, Value),
205 1
               XTN.Items (P));
206
         end;
207
      end if;
208

209 1
      Append_Node_To_List (P, XTN.Subitems (N));
210

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

215 1
      return N;
216 1
   end Map_Processor;
217

218
   --------------
219
   -- Map_Data --
220
   --------------
221

222 1
   function Map_Data (E : Node_Id) return Node_Id is
223 1
      N : Node_Id;
224 1
      P : Node_Id;
225

226
      Concurrency_Protocols : constant array
227
      (Supported_Concurrency_Control_Protocol'Range) of Name_Id :=
228 1
        (None_Specified   => Get_String_Name ("NO_PROTOCOL"),
229 1
         Priority_Ceiling => Get_String_Name ("PRIORITY_CEILING_PROTOCOL"),
230
         others           => No_Name);
231

232
   begin
233
      --  The structure of a XML node for a data is
234
      --  <!ELEMENT resource (cpu_name|
235
      --                      address_space_name|
236
      --                      name|
237
      --                      state|
238
      --                      protocol|
239
      --                      (state)?|
240
      --                      (resource_used_by)?)
241
      --  >
242

243 1
      N := Make_XML_Node ("resource");
244

245
      --  cpu_name: computed from the processor binding of the
246
      --  container process of the current data
247
      P :=
248 1
        Map_Node_Identifier_To_XML_Node
249
          ("cpu_name",
250 1
           Parent_Subcomponent
251 1
             (Get_Bound_Processor
252 1
                (Corresponding_Instance
253 1
                   (Get_Container_Process (Parent_Subcomponent (E))))));
254 1
      Append_Node_To_List (P, XTN.Subitems (N));
255

256
      --  address_space: name of the enclosing process
257
      P :=
258 1
        Map_Node_Identifier_To_XML_Node
259
          ("address_space_name",
260 1
           Get_Container_Process (Parent_Subcomponent (E)));
261 1
      Append_Node_To_List (P, XTN.Subitems (N));
262

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

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

271
      --  protocol: computed from Concurrency_Protocol property
272
      P :=
273 1
        Map_To_XML_Node
274
          ("protocol",
275 1
           Concurrency_Protocols (Get_Concurrency_Protocol (E)));
276 1
      Append_Node_To_List (P, XTN.Subitems (N));
277

278
      --  resource_used_by: computed from the list of threads
279
      --  accessing to this data component. Per construction, it is
280
      --  assumed to be computed from the list of connections in the
281
      --  enclosing process.
282 1
      P := Make_XML_Node ("resource_used_by");
283 1
      declare
284 1
         Access_List : constant AINU.Node_Array :=
285 1
           Connections_Of
286 1
             (Corresponding_Instance
287 1
                (Get_Container_Process (Parent_Subcomponent (E))));
288 1
         K, M       : Node_Id;
289
      begin
290 1
         for Connection of Access_List loop
291 1
            if Kind (Connection) = K_Connection_Instance
292 1
              and then Get_Category_Of_Connection (Connection) =
293
              CT_Access_Data
294
            then
295 1
               if Item (AIN.First_Node (Path (Source (Connection)))) =
296 1
                 Parent_Subcomponent (E)
297
               then
298 1
                  M := Make_XML_Node ("resource_user");
299
                  K :=
300 1
                    Make_Defining_Identifier
301 1
                      (Fully_Qualified_Instance_Name
302 1
                         (Corresponding_Instance
303 1
                            (Item
304 1
                               (AIN.First_Node
305 1
                                  (Path (Destination (Connection)))))));
306 1
                  Append_Node_To_List (K, XTN.Subitems (M));
307

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

312 1
                  K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
313 1
                  Append_Node_To_List (K, XTN.Subitems (M));
314 1
                  K :=
315 1
                    Make_Literal
316 1
                      (XV.New_Numeric_Value
317 1
                         (To_Microseconds
318 1
                            (Get_Execution_Time
319 1
                               (Corresponding_Instance
320 1
                                  (Item
321 1
                                     (AIN.First_Node
322 1
                                        (Path (Destination (Connection))))))
323
                               (1)),
324
                          1,
325
                          10));
326 1
                  Append_Node_To_List (K, XTN.Subitems (M));
327

328 1
                  Append_Node_To_List (M, XTN.Subitems (P));
329
               end if;
330
            end if;
331
         end loop;
332 1
      end;
333

334 1
      Append_Node_To_List (P, XTN.Subitems (N));
335

336 1
      return N;
337 1
   end Map_Data;
338

339
   -----------------
340
   -- Map_Process --
341
   -----------------
342

343 1
   function Map_Process (E : Node_Id) return Node_Id is
344 1
      N : Node_Id;
345 1
      P : Node_Id;
346
   begin
347
      --  The structure of a XML node for a address_space is
348
      --  <!ELEMENT address_space (name|
349
      --                           text_memory_size|
350
      --                           data_memory_size|
351
      --                           stack_memory_size|
352
      --                           heap_memory_size)
353
      --  >
354

355 1
      N := Make_XML_Node ("address_space");
356

357
      --  name: computed from process instance name
358
      P :=
359 1
        Map_Node_Identifier_To_XML_Node
360
          ("name",
361 1
           Fully_Qualified_Instance_Name (E));
362 1
      Append_Node_To_List (P, XTN.Subitems (N));
363

364
      --  cpu_name: computed from the processor binding of the
365
      --  container process of the current thread
366
      P :=
367 1
        Map_Node_Identifier_To_XML_Node
368
          ("cpu_name",
369 1
           Parent_Subcomponent (Get_Bound_Processor (E)));
370 1
      Append_Node_To_List (P, XTN.Subitems (N));
371

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

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

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

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

388 1
      return N;
389
   end Map_Process;
390

391
   ----------------
392
   -- Map_Thread --
393
   ----------------
394

395 1
   function Map_Thread (E : Node_Id) return Node_Id is
396 1
      N, P  : Node_Id;
397 1
      Value : Node_Id;
398 1
      Name  : Node_Id;
399

400
      Dispatch_Protocols : constant array
401
      (Supported_Thread_Dispatch_Protocol'Range) of Name_Id :=
402 1
        (Thread_Sporadic => Get_String_Name ("SPORADIC_TYPE"),
403 1
         Thread_Periodic => Get_String_Name ("PERIODIC_TYPE"),
404
         others          => No_Name);
405

406 1
      POSIX_Policies : constant array
407
      (Supported_POSIX_Scheduling_Policy'Range) of Name_Id :=
408 1
        (SCHED_FIFO   => Get_String_Name ("SCHED_FIFO"),
409 1
         SCHED_OTHERS => Get_String_Name ("SCHED_OTHERS"),
410 1
         SCHED_RR     => Get_String_Name ("SCHED_RR"),
411
         None         => No_Name);
412

413
      Dispatch : constant Supported_Thread_Dispatch_Protocol :=
414 1
        Get_Thread_Dispatch_Protocol (E);
415

416
      POSIX_Policy : constant Supported_POSIX_Scheduling_Policy :=
417 1
        Get_Thread_POSIX_Scheduling_Policy (E);
418

419
   begin
420
      --  The structure of a XML node for a task is
421
      --  <!ELEMENT task (name|
422
      --                  cpu_name|
423
      --                  address_space_name|
424
      --                  capacity|
425
      --                  start_time|
426
      --                  (stack_memory_size)?|
427
      --                  (text_memory_size)?|
428
      --                  (period)?|
429
      --                  (deadline)?|
430
      --                  (parameters)?|
431
      --                  (offsets)?|
432
      --                  (jitter)?|
433
      --                  (policy)?|
434
      --                  (priority)?|
435
      --                  (predictable_seed)?|
436
      --                  (blocking_time)?|
437
      --                  (seed)?|
438
      --                  (activation_rule)?)
439
      --  >
440

441 1
      N := Make_XML_Node ("task");
442

443
      --  task_type attribute
444
      --   supported values are PERIODIC or SPORADIC
445

446 1
      if Dispatch = Thread_Sporadic or else Dispatch = Thread_Periodic then
447 1
         Name  := Make_Defining_Identifier (Get_String_Name ("task_type"));
448 1
         Value := Make_Defining_Identifier (Dispatch_Protocols (Dispatch));
449 1
         Append_Node_To_List (Make_Assignement (Name, Value), XTN.Items (N));
450
      end if;
451

452
      --  cpu_name: computed from the processor binding of the
453
      --  container process of the current thread
454
      P :=
455 1
        Map_Node_Identifier_To_XML_Node
456
          ("cpu_name",
457 1
           Parent_Subcomponent
458 1
             (Get_Bound_Processor
459 1
                (Corresponding_Instance
460 1
                   (Get_Container_Process (Parent_Subcomponent (E))))));
461 1
      Append_Node_To_List (P, XTN.Subitems (N));
462

463
      --  address_space: name of the enclosing process
464
      P :=
465 1
        Map_Node_Identifier_To_XML_Node
466
          ("address_space_name",
467 1
           Fully_Qualified_Instance_Name
468 1
             (Corresponding_Instance
469 1
                (Get_Container_Process (Parent_Subcomponent (E)))));
470 1
      Append_Node_To_List (P, XTN.Subitems (N));
471

472
      --  name: computed from thread instance name
473
      P :=
474 1
        Map_Node_Identifier_To_XML_Node
475
          ("name",
476 1
           Fully_Qualified_Instance_Name (E));
477 1
      Append_Node_To_List (P, XTN.Subitems (N));
478

479
      --  capacity: computed from the Compute_Execution_Time property
480
      --  XXX for now, we take the first value
481 1
      if Get_Execution_Time (E) = Empty_Time_Array then
482 0
         Display_Located_Error
483 0
           (AIN.Loc (E),
484
            "Property Compute_Exeuction_Time not set," &
485
            " assuming default value of 0",
486
            Fatal   => False,
487
            Warning => True);
488

489 0
         P := Map_To_XML_Node ("capacity", Unsigned_Long_Long'(0));
490
      else
491 1
         P :=
492 1
           Map_To_XML_Node
493
             ("capacity",
494 1
              To_Microseconds (Get_Execution_Time (E) (1)));
495
      end if;
496 1
      Append_Node_To_List (P, XTN.Subitems (N));
497

498
      --  start_time: computed from First_Dispatch_Time property, XXX units
499
      P :=
500 1
        Map_To_XML_Node
501
          ("start_time",
502 1
           To_Microseconds (Get_Thread_First_Dispatch_Time (E)));
503 1
      Append_Node_To_List (P, XTN.Subitems (N));
504

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

511 1
      if Dispatch = Thread_Periodic or else Dispatch = Thread_Sporadic then
512
         --  deadline: computed from Deadline property, XXX check units
513
         P :=
514 1
           Map_To_XML_Node
515
             ("deadline",
516 1
              To_Microseconds (Get_Thread_Deadline (E)));
517 1
         Append_Node_To_List (P, XTN.Subitems (N));
518
      end if;
519

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

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

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

532
      --  stack_memory_size: computed from Source_Stack_Size property
533
      P :=
534 1
        Map_To_XML_Node
535
          ("stack_memory_size",
536 1
           To_Bytes (Get_Thread_Stack_Size (E)));
537 1
      Append_Node_To_List (P, XTN.Subitems (N));
538

539 1
      if Dispatch = Thread_Periodic or else Dispatch = Thread_Sporadic then
540
         --  period: computed from Period property, XXX check units
541
         P :=
542 1
           Map_To_XML_Node ("period", To_Microseconds (Get_Thread_Period (E)));
543 1
         Append_Node_To_List (P, XTN.Subitems (N));
544
      end if;
545

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

550 1
      return N;
551 1
   end Map_Thread;
552

553
   ----------------
554
   -- Map_Buffer --
555
   ----------------
556

557 1
   function Map_Buffer (E : Node_Id; P : Node_Id) return Node_Id is
558 1
      N : Node_Id;
559 1
      K : Node_Id;
560
   begin
561
      --  The structure of a XML node for a buffer is
562
      --  <!ELEMENT buffer (cpu_name|
563
      --                    address_space_name|
564
      --                    qs|
565
      --                    name|
566
      --                    size|
567
      --                    (buffer_used_by)?)
568
      --  >
569

570 1
      N := Make_XML_Node ("buffer");
571

572
      --  cpu_name: computed from the processor binding of the
573
      --  container process of the current thread
574
      K :=
575 1
        Map_Node_Identifier_To_XML_Node
576
          ("cpu_name",
577 1
           Parent_Subcomponent
578 1
             (Get_Bound_Processor
579 1
                (Corresponding_Instance
580 1
                   (Get_Container_Process (Parent_Subcomponent (E))))));
581 1
      Append_Node_To_List (K, XTN.Subitems (N));
582

583
      --  address_space: name of the enclosing process
584
      K :=
585 1
        Map_Node_Identifier_To_XML_Node
586
          ("address_space_name",
587 1
           Get_Container_Process (Parent_Subcomponent (E)));
588 1
      Append_Node_To_List (K, XTN.Subitems (N));
589

590
      --  qs: XXX
591 1
      K := Map_To_XML_Node ("qs", Get_String_Name ("QS_PP1"));
592 1
      Append_Node_To_List (K, XTN.Subitems (N));
593

594
      --  name: computed from thread instance name + port_name
595 1
      K := Map_To_XML_Node ("name", Map_Buffer_Name (E, P));
596 1
      Append_Node_To_List (K, XTN.Subitems (N));
597

598
      --  size: computed from the queue size
599
      declare
600 1
         Size : Long_Long := Get_Queue_Size (P);
601
      begin
602 1
         if Size = -1 then
603 1
            Size := 1;
604
         end if;
605 1
         K := Map_To_XML_Node ("size", Unsigned_Long_Long (Size));
606 1
         Append_Node_To_List (K, XTN.Subitems (N));
607
      end;
608

609
      --  buffer_used_by
610
      declare
611 1
         L : Node_Id;
612 1
         M : Node_Id;
613
      begin
614
         --  This node list all users of a particular buffer attached
615
         --  to the P in event (data) port.
616

617 1
         L := Make_XML_Node ("buffer_used_by");
618

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

622 1
         M := Make_XML_Node ("buffer_user");
623 1
         Append_Node_To_List
624 1
           (Make_Assignement
625 1
              (Make_Defining_Identifier (Get_String_Name ("buffer_role")),
626 1
               Make_Defining_Identifier (Get_String_Name ("consumer"))),
627 1
            XTN.Items (M));
628 1
         K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
629 1
         Append_Node_To_List (K, XTN.Subitems (M));
630 1
         K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
631 1
         Append_Node_To_List (K, XTN.Subitems (M));
632 1
         K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
633 1
         Append_Node_To_List (K, XTN.Subitems (M));
634 1
         Append_Node_To_List (M, XTN.Subitems (L));
635

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

638
         declare
639 1
            List_Sources : constant List_Id := Get_Source_Ports (P);
640 1
            Z            : Node_Id;
641
         begin
642 1
            if not AINU.Is_Empty (List_Sources) then
643 1
               Z := AIN.First_Node (List_Sources);
644 1
               while Present (Z) loop
645 1
                  M := Make_XML_Node ("buffer_user");
646
                  K :=
647 1
                    Make_Defining_Identifier
648 1
                      (Fully_Qualified_Instance_Name
649 1
                         (Parent_Component (Item (Z))));
650 1
                  Append_Node_To_List (K, XTN.Subitems (M));
651 1
                  K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
652 1
                  Append_Node_To_List (K, XTN.Subitems (M));
653 1
                  K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
654 1
                  Append_Node_To_List (K, XTN.Subitems (M));
655 1
                  Append_Node_To_List (M, XTN.Subitems (L));
656

657 1
                  Z := AIN.Next_Node (Z);
658 1
               end loop;
659
            end if;
660 1
            Append_Node_To_List (L, XTN.Subitems (N));
661
         end;
662
      end;
663

664 1
      return N;
665 1
   end Map_Buffer;
666

667
   --------------------
668
   -- Map_Dependency --
669
   --------------------
670

671 1
   function Map_Dependency (E : Node_Id; P : Node_Id) return Node_Id is
672 1
      N : Node_Id;
673 1
      K : Node_Id;
674
   begin
675
      --  The structure of a XML node for a dependency is
676
      --  XXX
677

678 1
      N := Make_XML_Node ("dependency");
679

680 1
      if Is_In (P) then
681 1
         Append_Node_To_List
682 1
           (Make_Assignement
683 1
              (Make_Defining_Identifier (Get_String_Name ("from_type")),
684 1
               Make_Defining_Identifier (Get_String_Name ("buffer"))),
685 1
            XTN.Items (N));
686 1
         K := Make_Defining_Identifier (Map_Buffer_Name (E, P));
687 1
         Append_Node_To_List (K, XTN.Subitems (N));
688 1
         K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
689 1
         Append_Node_To_List (K, XTN.Subitems (N));
690

691
      else
692 1
         if Present (AIN.First_Node (Get_Destination_Ports (P))) then
693
            --  We have to defends against the destination being an empty list.
694

695 1
            Append_Node_To_List
696 1
              (Make_Assignement
697 1
                 (Make_Defining_Identifier (Get_String_Name ("to_type")),
698 1
                  Make_Defining_Identifier (Get_String_Name ("buffer"))),
699 1
               XTN.Items (N));
700 1
            K := Make_Defining_Identifier (Fully_Qualified_Instance_Name (E));
701 1
            Append_Node_To_List (K, XTN.Subitems (N));
702
            K :=
703 1
              Make_Defining_Identifier
704 1
                (Map_Buffer_Name
705 1
                   (Parent_Component
706 1
                      (Item (AIN.First_Node (Get_Destination_Ports (P)))),
707 1
                    Item (AIN.First_Node (Get_Destination_Ports (P)))));
708

709 1
            Append_Node_To_List (K, XTN.Subitems (N));
710
         end if;
711
      end if;
712

713 1
      return N;
714
   end Map_Dependency;
715

716
end Ocarina.Backends.Cheddar.Mapping;

Read our documentation on viewing source code .

Loading