ocarina-backends-xtratum_conf-partition_table.adb 16.8 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-2014 ESA & ISAE.                    --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
--                                                                          --
-- Ocarina  is free software;  you  can  redistribute  it and/or  modify    --
-- it under terms of the GNU General Public License as published by the     --
-- Free Software Foundation; either version 2, or (at your option) any      --
-- later version. 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. See the GNU General --
-- Public License for more details. You should have received  a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING.   --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA.                                       --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable to be   --
-- covered  by the  GNU  General  Public  License. This exception does not  --
-- however invalidate  any other reasons why the executable file might be   --
-- covered by the GNU Public License.                                       --
--                                                                          --
jhugues's avatar
jhugues committed
29
30
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
31
32
33
--                                                                          --
------------------------------------------------------------------------------

34
with Ocarina.Namet; use Ocarina.Namet;
35
with Utils; use Utils;
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
76
77
78

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_Memory_Instance (E : Node_Id);
   procedure Visit_Processor_Instance (E : Node_Id);
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);

79
80
   Current_System : Node_Id := No_Node;

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
111
112
   -----------
   -- 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
113
      Category : constant Component_Category := Get_Category_Of_Component (E);
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
   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_Memory =>
            Visit_Memory_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;
142
143
      Base_Address_Value   : Unsigned_Long_Long;
      Byte_Count_Value     : Unsigned_Long_Long;
144
145
146
147
148
      Associated_Processor : Node_Id;
      Associated_Module    : Node_Id;
      Associated_Memory    : Node_Id;
      Physical_Areas_Node  : Node_Id;
      Temporal_Req_Node    : Node_Id;
149
150
      Port_Table_Node      : Node_Id;
      Port_Node            : Node_Id;
151
152
153
154
      Area_Node            : Node_Id;
      P                    : Node_Id;
      Q                    : Node_Id;
      S                    : Node_Id;
155
      F                    : Node_Id;
156
157
   begin
      Associated_Processor := Get_Bound_Processor (E);
158
159
160
      Associated_Memory    := Get_Bound_Memory (E);
      Associated_Module    :=
        Parent_Component (Parent_Subcomponent (Associated_Processor));
161
162
163
164
165
166

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

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

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

      if Associated_Module = No_Node then
         Display_Located_Error
181
182
183
           (AIN.Loc (E),
            "Unable to retrieve the module that executes this partition.",
            Fatal => True);
184
185
186
187
188
189
190
      end if;

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

      Partition_Node := Make_XML_Node ("Partition");

191
      Set_Str_To_Name_Buffer ("id");
192
193
194
      P := Make_Defining_Identifier (Name_Find);
      Q := Copy_Node (Backend_Node (Identifier (Associated_Processor)));
      Append_Node_To_List
195
196
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
197
198
199
200

      Set_Str_To_Name_Buffer ("name");
      P := Make_Defining_Identifier (Name_Find);
      Get_Name_String
201
        (To_Lower (Display_Name (Identifier (Parent_Subcomponent (E)))));
202
203
      Q := Make_Defining_Identifier (Name_Find);
      Append_Node_To_List
204
205
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
206
207
208
209
210
211

      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
212
213
        (Make_Assignement (P, Q),
         XTN.Items (Partition_Node));
214
215
216
217
218
219

      --  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");

220
      Append_Node_To_List (Physical_Areas_Node, XTN.Subitems (Partition_Node));
221
222
223

      Area_Node := Make_XML_Node ("Area");

224
      Base_Address_Value :=
225
        Get_Integer_Property (Associated_Memory, "base_address");
226
      Byte_Count_Value :=
227
        Get_Integer_Property (Associated_Memory, "byte_count");
228
229
      Set_Str_To_Name_Buffer ("start");
      P := Make_Defining_Identifier (Name_Find);
230
      Set_Str_To_Name_Buffer ("0x");
231
      Add_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Base_Address_Value));
232
233

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

235
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Area_Node));
236
237

      Set_Str_To_Name_Buffer ("size");
238
      P                := Make_Defining_Identifier (Name_Find);
239
      Byte_Count_Value := Byte_Count_Value / 1024;
240
      Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Byte_Count_Value));
241
      Add_Str_To_Name_Buffer ("KB");
242
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
243

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

246
      Append_Node_To_List (Area_Node, XTN.Subitems (Physical_Areas_Node));
247
248
249
250
251
252
253
254

      --  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
255
256
257
258
259
260
261
         Slots : constant Time_Array := Get_POK_Slots (Associated_Module);
         Slots_Allocation : constant List_Id    :=
           Get_POK_Slots_Allocation (Associated_Module);
         Duration    : Unsigned_Long_Long          := 0;
         Major_Frame : constant Unsigned_Long_Long :=
           To_Milliseconds (Get_POK_Major_Frame (Associated_Module));
         Part : Node_Id;
262
263
264
265
266
267
268
269
270
271
272
273
274
275
      begin
         S := ATN.First_Node (Slots_Allocation);
         for I in Slots'Range loop

            Part := ATE.Get_Referenced_Entity (S);

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

            S := ATN.Next_Node (S);
         end loop;
         Set_Str_To_Name_Buffer ("duration");
         P := Make_Defining_Identifier (Name_Find);
276
         Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Duration));
277
278
         Add_Str_To_Name_Buffer ("ms");
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
279
280

         Append_Node_To_List
281
282
           (Make_Assignement (P, Q),
            XTN.Items (Temporal_Req_Node));
283
284
285

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

         Append_Node_To_List
291
292
           (Make_Assignement (P, Q),
            XTN.Items (Temporal_Req_Node));
293
294
295

      end;

296
      Append_Node_To_List (Temporal_Req_Node, XTN.Subitems (Partition_Node));
297

298
299
300
301
302
303
304
305
306
307
      --  Now, handle the ports of the partition.
      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

               if not Is_Data (F) then
                  Display_Located_Error
308
309
310
                    (AIN.Loc (F),
                     "Pure events ports are not allowed.",
                     Fatal => True);
311
312
313
314
               end if;

               if Is_In (F) and then Is_Out (F) then
                  Display_Located_Error
315
316
317
                    (AIN.Loc (F),
                     "in/out ports are not allowed.",
                     Fatal => True);
318
319
320
321
322
323
324
325
               end if;

               Port_Node := Make_XML_Node ("Port");

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

               Get_Name_String (Display_Name (Identifier (F)));
326
               Q := Make_Defining_Identifier (To_Lower (Name_Find));
327
               Append_Node_To_List
328
329
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));
330
331
332
333
334
335
336

               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
337
                  Set_Str_To_Name_Buffer ("queuing");
338
339
340
341
               end if;

               Q := Make_Defining_Identifier (Name_Find);
               Append_Node_To_List
342
343
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));
344
345
346
347
348
349
350
351
352
353
354
355

               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
356
357
                 (Make_Assignement (P, Q),
                  XTN.Items (Port_Node));
358

359
               Append_Node_To_List (Port_Node, XTN.Subitems (Port_Table_Node));
360
361
362
363
364
365
366
            end if;
            F := Next_Node (F);
         end loop;

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

367
      Append_Node_To_List (Partition_Node, XTN.Subitems (Current_XML_Node));
368
369
370
371
372
373
374
   end Visit_Process_Instance;

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

   procedure Visit_System_Instance (E : Node_Id) is
375
376
377
      S : Node_Id;
      U : Node_Id;
      R : Node_Id;
378
379
380
381
   begin
      U := XTN.Unit (Backend_Node (Identifier (E)));
      R := XTN.Node (Backend_Node (Identifier (E)));

382
383
      Current_System := E;

384
385
386
387
388
389
390
391
      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
392
393
            --  Visit the component instance corresponding to the
            --  subcomponent S.
394
395
396
            if AINU.Is_Processor (Corresponding_Instance (S)) then
               Visit (Corresponding_Instance (S));
            end if;
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
            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");

417
418
419
      Append_Node_To_List
        (Partition_Table_Node,
         XTN.Subitems (Current_XML_Node));
420

421
422
423
424
425
      Current_XML_Node := Partition_Table_Node;

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
426
427
            --  Visit the component instance corresponding to the
            --  subcomponent S.
428
429
430
431
432

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

434
435
436
437
438
439
440
   end Visit_Processor_Instance;

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

   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
441
      S : Node_Id;
442
   begin
443
444
445
      if not AINU.Is_Empty (Subcomponents (Current_System)) then
         S := First_Node (Subcomponents (Current_System));
         while Present (S) loop
446
447
448
449
450
            --  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
451
452
453
454
455
456
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;

457
458
459
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
460
461
            --  Visit the component instance corresponding to the
            --  subcomponent S.
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

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

   ---------------------------
   -- Visit_Memory_Instance --
   ---------------------------

   procedure Visit_Memory_Instance (E : Node_Id) is
      pragma Unreferenced (E);
   begin
      null;
   end Visit_Memory_Instance;

end Ocarina.Backends.Xtratum_Conf.Partition_Table;