ocarina-backends-xtratum_conf-hardware_description.adb 16.6 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--           OCARINA.BACKENDS.XTRATUM_CONF.HARDWARE_DESCRIPTION             --
--                                                                          --
--                                 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

with Ocarina.ME_AADL;
38
with Ocarina.ME_AADL.AADL_Tree.Nodes;
39
with Ocarina.ME_AADL.AADL_Tree.Entities;
40
41
42
43
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;

44
45
with Ocarina.Instances.Queries;

46
with Ocarina.Backends.Utils;
47
with Ocarina.Backends.Messages;
48
49
50
51
52
53
54
55
56
57
with Ocarina.Backends.Properties;
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;
58
59
60

   use Ocarina.Instances.Queries;

61
   use Ocarina.Backends.Utils;
62
   use Ocarina.Backends.Messages;
63
64
65
66
   use Ocarina.Backends.Properties;
   use Ocarina.Backends.XML_Values;
   use Ocarina.Backends.XML_Tree.Nutils;

67
   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
68
   package ATE renames Ocarina.ME_AADL.AADL_Tree.Entities;
69
70
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
71
   package XV renames Ocarina.Backends.XML_Values;
72
73
74
75
76

   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);
77
   procedure Visit_Memory_Instance (E : Node_Id);
78
79
80
   procedure Visit_Processor_Instance (E : Node_Id);
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);

81
   Processor_Identifier : Unsigned_Long_Long := 0;
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
113
114

   -----------
   -- 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
115
      Category : constant Component_Category := Get_Category_Of_Component (E);
116
117
118
119
120
121
122
123
124
125
126
   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);

127
128
129
         when CC_Memory =>
            Visit_Memory_Instance (E);

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

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

   procedure Visit_System_Instance (E : Node_Id) is
153
154
155
      S              : Node_Id;
      Hw_Desc_Node   : Node_Id;
      Processor_Node : Node_Id;
156
      Memory_Node    : Node_Id;
157
      Device_Node    : Node_Id;
158
159
      U              : Node_Id;
      R              : Node_Id;
160
161
162
163
164
165
166
167
168
169
170
   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");

171
      Append_Node_To_List (Hw_Desc_Node, XTN.Subitems (Current_XML_Node));
172
173
174

      Processor_Node := Make_XML_Node ("ProcessorTable");

175
      Append_Node_To_List (Processor_Node, XTN.Subitems (Hw_Desc_Node));
176
177
178

      Current_XML_Node := Processor_Node;

179
180
181
      --  First, create the <ProcessorTable> section of the hardware
      --  description of the system.

182
183
184
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
185
186
            --  Visit the component instance corresponding to the
            --  subcomponent S.
187
188
189
190
191
192
            if AINU.Is_Processor (Corresponding_Instance (S)) then
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;
193
194
195
196
197
198

      --  Then, create the <MemoryLayout> section of the hardware
      --  description of the system.

      Memory_Node := Make_XML_Node ("MemoryLayout");

199
      Append_Node_To_List (Memory_Node, XTN.Subitems (Hw_Desc_Node));
200
201
202
203
204
205

      Current_XML_Node := Memory_Node;

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
206
207
            --  Visit the component instance corresponding to the
            --  subcomponent S.
208
209
210
211
212
213
214
            if AINU.Is_Memory (Corresponding_Instance (S)) then
               Visit (Corresponding_Instance (S));
            end if;
            S := Next_Node (S);
         end loop;
      end if;

215
216
217
218
219
220
221
222
223
224
225
226
227
228
      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);
229
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Uart_Node));
230
231
232
233
234

         Set_Str_To_Name_Buffer ("baudRate");
         P := Make_Defining_Identifier (Name_Find);
         Set_Str_To_Name_Buffer ("115200");
         Q := Make_Defining_Identifier (Name_Find);
235
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Uart_Node));
236
237
238
239
240

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

243
         Append_Node_To_List (Uart_Node, XTN.Subitems (Device_Node));
244
245
      end;

246
      Append_Node_To_List (Device_Node, XTN.Subitems (Hw_Desc_Node));
247

248
249
250
251
252
253
254
255
256
      Pop_Entity;
      Pop_Entity;
   end Visit_System_Instance;

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

   procedure Visit_Processor_Instance (E : Node_Id) is
257
258
259
260
261
262
263
264
265
266
267
268
      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;
      Slots            : constant Time_Array := Get_POK_Slots (E);
      Slots_Allocation : constant List_Id    := Get_POK_Slots_Allocation (E);
269
   begin
270
271
272
273
274
      if Slots_Allocation = No_List then
         Display_Error
           ("You must provide the slots allocation for each processor",
            Fatal => True);
      end if;
275

276
277
278
279
      --  First, add a <Processor> node
      Processor_Node := Make_XML_Node ("Processor");

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

      Append_Node_To_List
284
285
        (Make_Assignement (P, Q),
         XTN.Items (Processor_Node));
286
287
288
289
290
291
292
293

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

      Set_Str_To_Name_Buffer ("50Mhz");
      Q := Make_Defining_Identifier (Name_Find);

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

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

      Set_Str_To_Name_Buffer ("id");
      P := Make_Defining_Identifier (Name_Find);
      Q := Make_Literal (XV.New_Numeric_Value (0, 0, 10));
310

311
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Plan_Node));
312
313
314
315
316

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

      Set_Str_To_Name_Buffer
317
        (Unsigned_Long_Long'Image (To_Milliseconds (Get_POK_Major_Frame (E))));
318
      Add_Str_To_Name_Buffer ("ms");
319
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
320

321
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Plan_Node));
322
323
324
325
326
327

      --  For each time slot for a partition, we declare
      --  it in the scheduling plan.
      S := ATN.First_Node (Slots_Allocation);
      for I in Slots'Range loop

328
329
         Partition := ATE.Get_Referenced_Entity (S);

330
331
332
333
334
335
336
337
338
339
         --  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));

340
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
341
342
343
344
345
346
347

         --  Associate a fixed identifier to the slot.

         Set_Str_To_Name_Buffer ("partitionId");
         P := Make_Defining_Identifier (Name_Find);
         Q := Copy_Node (Backend_Node (Identifier (Partition)));

348
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
349
350
351
352
353

         --  Define the duration attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("duration");
         P := Make_Defining_Identifier (Name_Find);
         Set_Str_To_Name_Buffer
354
           (Unsigned_Long_Long'Image (To_Milliseconds (Slots (I))));
355
         Add_Str_To_Name_Buffer ("ms");
356
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
357
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
358
359
360
361

         --  Define the start attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("start");
         P := Make_Defining_Identifier (Name_Find);
362
         Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Start_Time));
363
         Add_Str_To_Name_Buffer ("ms");
364
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
365
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
366
367
368
369
370
371
372
373
374

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

         Slot_Identifier := Slot_Identifier + 1;

         Start_Time := Start_Time + To_Milliseconds (Slots (I));

         S := ATN.Next_Node (S);
      end loop;
375
376
377
378

      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
379
380
            --  Visit the component instance corresponding to the
            --  subcomponent S.
381
382
383
384
385

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
386
387
388
389

      Processor_Identifier := Processor_Identifier + 1;

      Append_Node_To_List (Processor_Node, XTN.Subitems (Current_XML_Node));
390
391
392
393
394
395
396
   end Visit_Processor_Instance;

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

   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
397
      S : Node_Id;
398
399
400
401
   begin
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
402
403
            --  Visit the component instance corresponding to the
            --  subcomponent S.
404
405
406
407
408
409
410

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

411
412
413
414
415
   ---------------------------
   -- Visit_Memory_Instance --
   ---------------------------

   procedure Visit_Memory_Instance (E : Node_Id) is
416
417
418
419
420
      P                  : Node_Id;
      Q                  : Node_Id;
      Memory_Node        : Node_Id;
      Base_Address_Value : Unsigned_Long_Long;
      Byte_Count_Value   : Unsigned_Long_Long;
421
422
423
424
   begin
      Memory_Node := Make_XML_Node ("Region");

      --  Add the start attribute of the region node.
425
      Base_Address_Value := Get_Integer_Property (E, "base_address");
426
      Byte_Count_Value   := Get_Integer_Property (E, "byte_count");
427
428
429

      if Base_Address_Value = 0 or else Byte_Count_Value = 0 then
         Display_Located_Error
430
431
432
433
           (Loc (E),
            "Memory does not specify the byte_count " &
            "or base_address properties (not fatal)",
            Fatal => False);
434
435
436
         return;
      end if;

437
438
      Set_Str_To_Name_Buffer ("start");
      P := Make_Defining_Identifier (Name_Find);
439
      Set_Str_To_Name_Buffer ("0x");
440
      Add_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Base_Address_Value));
441
442

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

444
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
445
446
447
448

      --  Add the size attribute of the region node.
      Set_Str_To_Name_Buffer ("size");
      P := Make_Defining_Identifier (Name_Find);
449
      Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Byte_Count_Value));
450
451
      Add_Str_To_Name_Buffer ("B");
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
452

453
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
454
455
456
457
458
459
460

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

461
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
462
463
464
465

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

466
end Ocarina.Backends.Xtratum_Conf.Hardware_Description;