ocarina-backends-xtratum_conf-hardware_description.adb 16.9 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--           OCARINA.BACKENDS.XTRATUM_CONF.HARDWARE_DESCRIPTION             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
yoogx's avatar
yoogx committed
9
--                   Copyright (C) 2011-2016 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
--                                                                          --
------------------------------------------------------------------------------

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

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

40
41
with Ocarina.Instances.Queries;

42
with Ocarina.Backends.Utils;
43
with Ocarina.Backends.Messages;
44
with Ocarina.Backends.Properties;
yoogx's avatar
yoogx committed
45
with Ocarina.Backends.Properties.ARINC653;
46
47
48
49
50
51
52
53
54
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;
55
56
57

   use Ocarina.Instances.Queries;

58
   use Ocarina.Backends.Utils;
59
   use Ocarina.Backends.Messages;
60
   use Ocarina.Backends.Properties;
yoogx's avatar
yoogx committed
61
   use Ocarina.Backends.Properties.ARINC653;
62
63
64
65
66
   use Ocarina.Backends.XML_Values;
   use Ocarina.Backends.XML_Tree.Nutils;

   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
67
   package XV renames Ocarina.Backends.XML_Values;
68
69
70
71
72

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

77
   Processor_Identifier : Unsigned_Long_Long := 0;
78
79
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

   -----------
   -- 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
111
      Category : constant Component_Category := Get_Category_Of_Component (E);
112
113
114
115
116
117
118
119
120
121
122
   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);

123
124
125
         when CC_Memory =>
            Visit_Memory_Instance (E);

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

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

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

167
      Append_Node_To_List (Hw_Desc_Node, XTN.Subitems (Current_XML_Node));
168
169
170

      Processor_Node := Make_XML_Node ("ProcessorTable");

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

      Current_XML_Node := Processor_Node;

175
176
177
      --  First, create the <ProcessorTable> section of the hardware
      --  description of the system.

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

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

      Memory_Node := Make_XML_Node ("MemoryLayout");

195
      Append_Node_To_List (Memory_Node, XTN.Subitems (Hw_Desc_Node));
196
197
198
199
200
201

      Current_XML_Node := Memory_Node;

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

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

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

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

239
         Append_Node_To_List (Uart_Node, XTN.Subitems (Device_Node));
240
241
      end;

242
      Append_Node_To_List (Device_Node, XTN.Subitems (Hw_Desc_Node));
243

244
245
246
247
248
249
250
251
252
      Pop_Entity;
      Pop_Entity;
   end Visit_System_Instance;

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

   procedure Visit_Processor_Instance (E : Node_Id) is
yoogx's avatar
yoogx committed
253
254
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;

      Module_Schedule : constant Schedule_Window_Record_Term_Array :=
        Get_Module_Schedule_Property (E);

267
   begin
yoogx's avatar
yoogx committed
268
      if Module_Schedule'Length = 0 then
269
270
271
272
         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

      --  For each time slot for a partition, we declare
      --  it in the scheduling plan.

yoogx's avatar
yoogx committed
324
325
      for J in Module_Schedule'Range loop
         Partition := Module_Schedule (J).Partition;
326

327
328
329
330
331
332
333
334
335
         --  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));
336
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
337

yoogx's avatar
yoogx committed
338
339
         --  Define the start attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("start");
340
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
341
342
343
         Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Start_Time));
         Add_Str_To_Name_Buffer ("ms");
         Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
344
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
345
346
347
348

         --  Define the duration attribute of the <slot/> element.
         Set_Str_To_Name_Buffer ("duration");
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
349

350
         Set_Str_To_Name_Buffer
yoogx's avatar
yoogx committed
351
352
           (Unsigned_Long_Long'Image
              (To_Milliseconds (Module_Schedule (J).Duration)));
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

yoogx's avatar
yoogx committed
357
358
359
360
361
362
363
364
365
366
367
368
369
         --  Associate a fixed identifier to the slot.
         if not AINU.Is_Empty (Subcomponents (E)) then
            S := First_Node (Subcomponents (E));
            while Present (S) loop
               if Corresponding_Declaration (S) =
                 Module_Schedule (J).Partition
               then
                  Partition := Corresponding_Instance (S);
               end if;
               S := Next_Node (S);
            end loop;
         end if;
         Set_Str_To_Name_Buffer ("partitionId");
370
         P := Make_Defining_Identifier (Name_Find);
yoogx's avatar
yoogx committed
371
372
373
374
375
376
377

         Q :=
           Make_Literal
             (XV.New_Numeric_Value
                (Get_Partition_Identifier (Partition),
                 0,
                 10));
378
         Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Slot_Node));
379
380
381
382
383

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

         Slot_Identifier := Slot_Identifier + 1;

yoogx's avatar
yoogx committed
384
385
         Start_Time :=
           Start_Time + To_Milliseconds (Module_Schedule (J).Duration);
386
387

      end loop;
388
389
390
391

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

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
399
400
401
402

      Processor_Identifier := Processor_Identifier + 1;

      Append_Node_To_List (Processor_Node, XTN.Subitems (Current_XML_Node));
403
404
405
406
407
408
409
   end Visit_Processor_Instance;

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

   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
410
      S : Node_Id;
411
412
413
414
   begin
      if not AINU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
415
416
            --  Visit the component instance corresponding to the
            --  subcomponent S.
417
418
419
420
421
422
423

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

424
425
426
427
428
   ---------------------------
   -- Visit_Memory_Instance --
   ---------------------------

   procedure Visit_Memory_Instance (E : Node_Id) is
429
430
431
432
433
      P                  : Node_Id;
      Q                  : Node_Id;
      Memory_Node        : Node_Id;
      Base_Address_Value : Unsigned_Long_Long;
      Byte_Count_Value   : Unsigned_Long_Long;
434
435
436
437
   begin
      Memory_Node := Make_XML_Node ("Region");

      --  Add the start attribute of the region node.
438
      Base_Address_Value := Get_Integer_Property (E, "base_address");
439
      Byte_Count_Value   := Get_Integer_Property (E, "byte_count");
440
441
442

      if Base_Address_Value = 0 or else Byte_Count_Value = 0 then
         Display_Located_Error
443
444
445
446
           (Loc (E),
            "Memory does not specify the byte_count " &
            "or base_address properties (not fatal)",
            Fatal => False);
447
448
449
         return;
      end if;

450
451
      Set_Str_To_Name_Buffer ("start");
      P := Make_Defining_Identifier (Name_Find);
452
      Set_Str_To_Name_Buffer ("0x");
453
      Add_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Base_Address_Value));
454
455

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

457
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
458
459
460
461

      --  Add the size attribute of the region node.
      Set_Str_To_Name_Buffer ("size");
      P := Make_Defining_Identifier (Name_Find);
462
      Set_Str_To_Name_Buffer (Unsigned_Long_Long'Image (Byte_Count_Value));
463
464
      Add_Str_To_Name_Buffer ("B");
      Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
465

466
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
467
468
469
470
471
472
473

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

474
      Append_Node_To_List (Make_Assignement (P, Q), XTN.Items (Memory_Node));
475
476
477
478

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

479
end Ocarina.Backends.Xtratum_Conf.Hardware_Description;