ocarina-backends-xtratum_conf-hardware_description.adb 16.5 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--           OCARINA.BACKENDS.XTRATUM_CONF.HARDWARE_DESCRIPTION             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--                   Copyright (C) 2011-2015 ESA & ISAE.                    --
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27
28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29
30
31
--                                                                          --
------------------------------------------------------------------------------

32
with Ocarina.Namet; use Ocarina.Namet;
33
with Utils; use Utils;
34
35

with Ocarina.ME_AADL;
36
with Ocarina.ME_AADL.AADL_Tree.Nodes;
37
with Ocarina.ME_AADL.AADL_Tree.Entities;
38
39
40
41
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;

42
43
with Ocarina.Instances.Queries;

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

   use Ocarina.Instances.Queries;

59
   use Ocarina.Backends.Utils;
60
   use Ocarina.Backends.Messages;
61
62
63
64
   use Ocarina.Backends.Properties;
   use Ocarina.Backends.XML_Values;
   use Ocarina.Backends.XML_Tree.Nutils;

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

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

79
   Processor_Identifier : Unsigned_Long_Long := 0;
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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
   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);

125
126
127
         when CC_Memory =>
            Visit_Memory_Instance (E);

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

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

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

169
      Append_Node_To_List (Hw_Desc_Node, XTN.Subitems (Current_XML_Node));
170
171
172

      Processor_Node := Make_XML_Node ("ProcessorTable");

173
      Append_Node_To_List (Processor_Node, XTN.Subitems (Hw_Desc_Node));
174
175
176

      Current_XML_Node := Processor_Node;

177
178
179
      --  First, create the <ProcessorTable> section of the hardware
      --  description of the system.

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

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

      Memory_Node := Make_XML_Node ("MemoryLayout");

197
      Append_Node_To_List (Memory_Node, XTN.Subitems (Hw_Desc_Node));
198
199
200
201
202
203

      Current_XML_Node := Memory_Node;

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

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

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

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

241
         Append_Node_To_List (Uart_Node, XTN.Subitems (Device_Node));
242
243
      end;

244
      Append_Node_To_List (Device_Node, XTN.Subitems (Hw_Desc_Node));
245

246
247
248
249
250
251
252
253
254
      Pop_Entity;
      Pop_Entity;
   end Visit_System_Instance;

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

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

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

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

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

      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
292
293
        (Make_Assignement (P, Q),
         XTN.Items (Processor_Node));
294
295
296
297
298
299
300
301
302
303
304
305
306
307

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

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

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

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

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

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

326
327
         Partition := ATE.Get_Referenced_Entity (S);

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

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

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

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

         --  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
352
           (Unsigned_Long_Long'Image (To_Milliseconds (Slots (I))));
353
         Add_Str_To_Name_Buffer ("ms");
354
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
355
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
356
357
358
359

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

         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;
373
374
375
376

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

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
384
385
386
387

      Processor_Identifier := Processor_Identifier + 1;

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

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

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

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

409
410
411
412
413
   ---------------------------
   -- Visit_Memory_Instance --
   ---------------------------

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

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

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

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

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

442
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
443
444
445
446

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

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

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

459
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
460
461
462
463

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

464
end Ocarina.Backends.Xtratum_Conf.Hardware_Description;