taste-deployment_view.adb 30.4 KB
Newer Older
1
--  *************************** taste aadl parser ***********************  --
2
--  (c) 2018 European Space Agency - maxime.perrotin@esa.int
3
4
5
6
--  LGPL license, see LICENSE file

--  Deployment View parser

7
with Ada.Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
8
     Ada.Strings.Fixed,
9
     System.Assertions,
10
     Ocarina.Instances.Queries,
11
     Ocarina.Instances,
Maxime Perrotin's avatar
Maxime Perrotin committed
12
13
14
     Ocarina.Files,
     Ocarina.FE_AADL.Parser,
     Ocarina.Parser,
15
16
17
     Ocarina.Namet,
     Ocarina.Analyzer,
     Ocarina.Options,
18
     Ocarina.Backends.Properties.ARINC653,
Maxime Perrotin's avatar
Maxime Perrotin committed
19
     Locations,
20
21
22
23
     Ocarina.ME_AADL.AADL_Instances.Nodes,
     Ocarina.ME_AADL.AADL_Instances.Nutils,
     Ocarina.ME_AADL.AADL_Instances.Entities;

24
package body TASTE.Deployment_View is
25

26
   use Ada.Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
27
       Ada.Strings.Fixed,
28
       System.Assertions,
29
       Ocarina.Instances.Queries,
30
       Ocarina.Namet,
Maxime Perrotin's avatar
Maxime Perrotin committed
31
       Ocarina.FE_AADL.Parser,
32
       Ocarina.Backends.Properties.ARINC653,
Maxime Perrotin's avatar
Maxime Perrotin committed
33
       Locations,
34
35
36
37
       Ocarina.ME_AADL.AADL_Instances.Nodes,
       Ocarina.ME_AADL.AADL_Instances.Nutils,
       Ocarina.ME_AADL.AADL_Instances.Entities,
       Ocarina.ME_AADL;
Maxime Perrotin's avatar
Maxime Perrotin committed
38

39
   function Initialize (Root : Node_Id) return Node_Id is
Maxime Perrotin's avatar
Maxime Perrotin committed
40
      Root_Depl      : Node_Id := Root;
41
42
43
      Success        : Boolean;
      Root_Instance  : Node_Id;
      AADL_Language  : constant Name_Id := Get_String_Name ("aadl");
Maxime Perrotin's avatar
Maxime Perrotin committed
44
45
      Loc : Location;
      F   : Name_Id;
46
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
47
48
49
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;

      --  Parse all AADL files possibly needed to instantiate the model
Maxime Perrotin's avatar
Maxime Perrotin committed
50
51
      for Each of AADL_Lib loop
         Set_Str_To_Name_Buffer (Each);
Maxime Perrotin's avatar
Maxime Perrotin committed
52
53
54
55
56
57
58
         F := Ocarina.Files.Search_File (Name_Find);
         Loc := Ocarina.Files.Load_File (F);
         Root_Depl := Ocarina.Parser.Parse (Get_String_Name ("aadl"),
                                            Root_Depl, Loc);
      end loop;

      Success := Ocarina.Analyzer.Analyze (AADL_Language, Root_Depl);
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

      if not Success then
         raise Deployment_View_Error with "Deployment view is incorrect";
      end if;

      Ocarina.Options.Root_System_Name :=
        Get_String_Name ("deploymentview.others");

      --  Instantiate AADL tree
      Root_Instance := Ocarina.Instances.Instantiate_Model (Root => Root);
      return Root_System (Root_Instance);
   end Initialize;

   ---------------------------
   -- AST Builder Functions --
   ---------------------------

Maxime Perrotin's avatar
Maxime Perrotin committed
76
77
   function Parse_Deployment_View (System : Node_Id)
                                   return Complete_Deployment_View
78
   is
79
80
      use type Bus_Connections.Vector;

81
      Nodes          : Node_Maps.Map;
82
      Node           : Taste_Node;
83
      Busses         : Taste_Busses.Vector;
84
      Conns          : Bus_Connections.Vector;
85
86
87
88
89
90
      My_Root_System : Node_Id;
      Subs           : Node_Id;
      CI             : Node_Id;

      function Parse_Bus (Elem : Node_Id; Bus : Node_Id) return Taste_Bus is
         Properties : constant Property_Maps.Map := Get_Properties_Map (CI);
Maxime Perrotin's avatar
Maxime Perrotin committed
91
         Classifier : Name_Id;
92
93
94
95
96
97
98
         Pkg_Name   : Name_Id := No_Name;
      begin
         Set_Str_To_Name_Buffer ("");
         if ATN.Namespace
             (Corresponding_Declaration (Bus)) /= No_Node
         then
            Set_Str_To_Name_Buffer ("");
Maxime Perrotin's avatar
Maxime Perrotin committed
99
100
            Get_Name_String (ATN.Name (ATN.Identifier (ATN.Namespace
                             (Corresponding_Declaration (Bus)))));
101
102
103
104
105
106
107
108
109
            Pkg_Name := Name_Find;
            Set_Str_To_Name_Buffer ("");
            Get_Name_String (Pkg_Name);
            Add_Str_To_Name_Buffer ("::");
            Get_Name_String_And_Append
               (Name (Identifier (Bus)));
            Classifier := Name_Find;
         else
            Classifier := Name (Identifier (Bus));
Maxime Perrotin's avatar
Maxime Perrotin committed
110
            --  No "default" Pkg_Name?
111
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
112
         return Taste_Bus'(Name         =>
113
                             US (Get_Name_String (Name (Identifier (Elem)))),
Maxime Perrotin's avatar
Maxime Perrotin committed
114
115
116
                           AADL_Package => US (Get_Name_String (Pkg_Name)),
                           Classifier   => US (Get_Name_String (Classifier)),
                           Properties   => Properties);
117
      end Parse_Bus;
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

      function Parse_Connections (CI : Node_Id) return Bus_Connections.Vector
      is
         use Bus_Connections;
         Conn           : Node_Id;
         Bound_Bus      : Node_Id;
         Src_Port       : Node_Id;
         Src_Name       : Unbounded_String;
         Dst_Name       : Unbounded_String;
         Dst_Port       : Node_Id;
         Bound_Bus_Name : Name_Id;
         If1_Name       : Name_Id;
         If2_Name       : Name_Id;
         Result         : Bus_Connections.Vector;
      begin
         Conn := First_Node (Connections (CI));
         while Present (Conn) loop
            Bound_Bus := Get_Bound_Bus (Conn, False);
            if Bound_Bus /= No_Node then
               Bound_Bus_Name := Name
                  (Identifier (Parent_Subcomponent (Bound_Bus)));
               Src_Port := Get_Referenced_Entity (Source (Conn));
               Dst_Port := Get_Referenced_Entity (Destination (Conn));
               If1_Name := Get_Interface_Name (Src_Port);
               If2_Name := Get_Interface_Name (Dst_Port);
               --  Get_Interface_Name is v1.3.5+ only
               if If1_Name /= No_Name and If2_Name /= No_Name then
                  Src_Name := US (Get_Name_String (If1_Name));
                  Dst_Name := US (Get_Name_String (If2_Name));
               else
                  --  Keep compatibility with v1.2
                  Src_Name := US (Get_Name_String (Display_Name
                                                  (Identifier (Src_Port))));

                  Dst_Name := US (Get_Name_String (Display_Name
                                                  (Identifier (Dst_Port))));
               end if;
               Result := Result
                 & Bus_Connection'(Source_Node => Src_Name,
                                   Source_Port => US (Get_Name_String
                                     (Name (Identifier
                                      (Parent_Subcomponent
                                           (Parent_Component (Src_Port)))))),
                                   Bus_Name    =>
                                     US (Get_Name_String (Bound_Bus_Name)),
                                   Dest_Node   => Dst_Name,
                                   Dest_Port   => US (Get_Name_String
                                     (Name (Identifier
                                      (Parent_Subcomponent
                                           (Parent_Component (Src_Port)))))));
            end if;
            Conn := Next_Node (Conn);
         end loop;
         return Result;
      end Parse_Connections;

174
175
176
177
178
179
180
181
182
183
184
185
186
      --  Find the bus that is connected to a device through a require access
      procedure Find_Connected_Bus (Device        : Node_Id;
                                    Accessed_Bus  : out Node_Id;
                                    Accessed_Port : out Node_Id) is
         F   : Node_Id;
         Src : Node_Id;
      begin
         Accessed_Bus := No_Node;
         Accessed_Port := No_Node;
         if not Is_Empty (Features (Device)) then
            F := First_Node (Features (Device));
            while Present (F) loop
               --  The sources of F
Maxime Perrotin's avatar
Maxime Perrotin committed
187
188
               if not Is_Empty (AIN.Sources (F)) then
                  Src := First_Node (AIN.Sources (F));
189
190
                  if Src /= No_Node then
                     if Item (Src) /= No_Node and then
Maxime Perrotin's avatar
Maxime Perrotin committed
191
192
                        not Is_Empty (AIN.Sources (Item (Src))) and then
                        First_Node (AIN.Sources (Item (Src))) /= No_Node
193
                     then
Maxime Perrotin's avatar
Maxime Perrotin committed
194
                        Src := Item (First_Node (AIN.Sources (Item (Src))));
195
196
197
198
199
200
201
202
203
204
                        Accessed_Bus := Src;
                        Accessed_Port := F;
                     end if;
                  end if;
               end if;
               F := Next_Node (F);
            end loop;
         end if;
      end Find_Connected_Bus;

Maxime Perrotin's avatar
Maxime Perrotin committed
205
      function Parse_Device (CI : Node_Id) return Taste_Device_Driver is
206
         Result : Taste_Device_Driver;
Maxime Perrotin's avatar
Maxime Perrotin committed
207
208
209
210
211
         Pkg_Name                   : Name_Id;
         Accessed_Bus               : Node_Id;
         Accessed_Port              : Node_Id;
         Device_Implementation      : Node_Id;
         Configuration_Data         : Node_Id;
212
213
214
215
216
217
218
219
220
221
222
223
224
225
      begin
         Result.Name := US (Get_Name_String (Name (Identifier (CI))));

         Device_Implementation := Get_Implementation (CI);

         if Device_Implementation /= No_Node and then
            Is_Defined_Property (Device_Implementation,
                                 "deployment::configuration_type")
         then
            Configuration_Data := Get_Classifier_Property
                (Device_Implementation, "deployment::configuration_type");

            if Is_Defined_Property (Configuration_Data, "type_source_name")
            then
226
227
228
               Result.ASN1_Typename :=
                 US (Get_Name_String (Get_String_Property
                    (Configuration_Data, "type_source_name")));
229
230
231
232
               declare
                  ST : constant Name_Array :=
                    Get_Source_Text (Configuration_Data);
               begin
233
234
235
236
237
238
                  --  ST is a tuple (asn.1 file, .h file)
                  if ST'Length = 0 then
                     raise Device_Driver_Error with "Driver error ("
                       & To_String (Result.Name)
                       & ") : Missing configuration data";
                  end if;
239
240
                  for Index in ST'Range loop
                     Get_Name_String (ST (Index));
Maxime Perrotin's avatar
Maxime Perrotin committed
241
                     pragma Assert (Name_Len >= 1 and then Name_Len <= 16384);
Maxime Perrotin's avatar
Maxime Perrotin committed
242
243
                     if Tail (Source => Name_Buffer (1 .. Name_Len),
                              Count  => 4) = ".asn"
244
                     then
Maxime Perrotin's avatar
Maxime Perrotin committed
245
246
                        Result.ASN1_Filename :=
                          US (Name_Buffer (1 .. Name_Len));
247
248
249
250
                     end if;
                  end loop;
               end;
            end if;
251
252
253
254
255
256
            if Result.ASN1_Filename = US ("") then
               raise Device_Driver_Error with "Driver error ("
                 & To_String (Result.Name)
                 & ") : Missing ASN.1 configuration file";
            end if;

257
258
259
            if Is_Defined_Property
                 (Configuration_Data, "deployment::asn1_module_name")
            then
260
261
262
               Result.ASN1_Module := US (Get_Name_String
                                                (Get_String_Property
                 (Configuration_Data, "deployment::asn1_module_name")));
263
            else
264
265
               raise Device_Driver_Error with "Driver error ("
                 & To_String (Result.Name) & ") : Missing ASN.1 module name";
266
267
268
269
270
271
272
273
274
275
276
277
278
279
            end if;
         else
            raise Device_Driver_Error with
              "Device configuration is incorrect ("
              & Get_Name_String (Name (Identifier (CI))) & ")";
         end if;

         Set_Str_To_Name_Buffer ("");
         if ATN.Namespace (Corresponding_Declaration (CI)) /= No_Node
         then
            Set_Str_To_Name_Buffer ("");
            Get_Name_String (ATN.Name (ATN.Identifier
                        (ATN.Namespace (Corresponding_Declaration (CI)))));
            Pkg_Name := Name_Find;
280
281
282
            --  CHECKME : I don't kwnow when this needed, check buildsupport
            --            C_Add_Package   (Get_Name_String (Pkg_Name),
            Result.Package_Name := US (Get_Name_String (Pkg_Name));
283
284
285
286
            Set_Str_To_Name_Buffer ("");
            Get_Name_String (Pkg_Name);
            Add_Str_To_Name_Buffer ("::");
            Get_Name_String_And_Append (Name (Identifier (CI)));
287
            Result.Device_Classifier := US (Get_Name_String (Name_Find));
288
         else
289
290
            Result.Device_Classifier :=
              US (Get_Name_String (Name (Identifier (CI))));
291
292
293
294
         end if;

         if Get_Bound_Processor (CI) /= No_Node then
            Set_Str_To_Name_Buffer ("");
295
296
            Result.Associated_Processor_Name := US (Get_Name_String (Name
               (Identifier (Parent_Subcomponent (Get_Bound_Processor (CI))))));
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
         end if;

         if Is_Defined_Property (CI, "deployment::configuration") and then
            Get_String_Property (CI, "deployment::configuration") /= No_Name
         then
            Result.Device_Configuration :=
              US (Get_Name_String
                  (Get_String_Property (CI, "deployment::configuration")));
         else
            Result.Device_Configuration := US ("noconf");
         end if;

         Find_Connected_Bus (CI, Accessed_Bus, Accessed_Port);

         if Accessed_Bus /= No_Node and then Accessed_Port /= No_Node
         then
            Result.Accessed_Bus_Name :=
              US (Get_Name_String (Name (Identifier (Accessed_Bus))));
            Result.Accessed_Port_Name :=
              US (Get_Name_String (Name (Identifier (Accessed_Port))));
         end if;
         return Result;
319
320
321
322
323
324
      exception
         when Error : Device_Driver_Error =>
            raise Device_Driver_Error with Exception_Message (Error);
         when Error : others =>
            raise Device_Driver_Error with "Device driver unknown error : "
              & Exception_Message (Error);
325
326
      end Parse_Device;

Maxime Perrotin's avatar
Maxime Perrotin committed
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
      --  TSP systems have memory regions, declared in the deployment view
      --  the partitions are bound to the memory region. This function
      --  is a placeholder to parse any required memory information.
      --  Currently the backends only need to know that a memory is defined
      --  actual size or segements information are not needed to build the
      --  concurrency view.
      function Parse_Memory (CI : Node_Id;
                             dummy_Depl : Node_Id) return Taste_Memory
      is
         Result : Taste_Memory;
      begin
         Result.Name :=  -- Memory identifier (usually "main_memory")
           US (Get_Name_String (ATN.Name (ATN.Component_Type_Identifier
               (Corresponding_Declaration (CI)))));
         return Result;
      end Parse_Memory;

344
345
346
347
348
349
350
      function Parse_Partition (CI : Node_Id; Depl : Node_Id)
                                return Taste_Partition is
         Result         : Taste_Partition;
         CPU            : Node_Id;
         Processes      : Node_Id;
         P_CI           : Node_Id;
         Ref            : Node_Id;
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
         procedure Separate_CPU_Family_From_Instance
         --  If the CPU in the AADL model is "leon3.air", then split into
         --  family "leon3" and instance "air" based on dot separator
           (CPU              : Node_Id;
            Family, Instance : out Unbounded_String) is
            CPU_With_Instance : constant String :=
              Get_Name_String (Name (Identifier (CPU)));
            Dot : constant Natural := Index (CPU_With_Instance, ".");
            Fam : constant String :=
              (if Dot > 0
               then CPU_With_Instance (CPU_With_Instance'First .. Dot - 1)
               else "");
            Inst : constant String :=
              (if Dot >= CPU_With_Instance'First
               and then Dot + 1 <= CPU_With_Instance'Last
               then CPU_With_Instance (Dot + 1 .. CPU_With_Instance'Last)
               else "");
         begin
            Family := US (Fam);
            Instance := US (Inst);
         end Separate_CPU_Family_From_Instance;

373
374
375
376
377
378
379
380
381
382
      begin
         if Is_Defined_Property (CI, "taste_dv_properties::coverageenabled")
         then
            Result.Coverage := Get_Boolean_Property
               (CI, Get_String_Name ("taste_dv_properties::coverageenabled"));
         end if;

         CPU := Get_Bound_Processor (CI);

         Result.CPU_Name :=
Maxime Perrotin's avatar
Maxime Perrotin committed
383
384
385
           US
             (Get_Name_String (Name (Identifier (Parent_Subcomponent (CPU)))));

386
387
388
         Separate_CPU_Family_From_Instance (CPU,
                                            Result.CPU_Family,
                                            Result.CPU_Instance);
389
390

         Result.CPU_Platform := Get_Execution_Platform (CPU);
391
392
393
394
395
         if Result.CPU_Platform = Platform_GNAT_Runtime then
            Result.Ada_Runtime := US (Get_Name_String (Get_Ada_Runtime (CPU)));
         else
            Result.Ada_Runtime := US ("");
         end if;
396
397
398
399
400
401
402

         if ATN.Namespace (Corresponding_Declaration (CPU)) /= No_Node
         then
            Set_Str_To_Name_Buffer ("");
            Get_Name_String (ATN.Name (ATN.Identifier (ATN.Namespace
                        (Corresponding_Declaration (CPU)))));
            Result.Package_Name := US (Get_Name_String (Name_Find));
403

404
405
406
407
408
409
410
411
412
413
414
415
416
            Set_Str_To_Name_Buffer ("");
            Get_Name_String
              (Get_String_Name (To_String (Result.Package_Name)));
            Add_Str_To_Name_Buffer ("::");
            Get_Name_String_And_Append (Name (Identifier (CPU)));
            Result.CPU_Classifier := US (Get_Name_String (Name_Find));
         else
            Result.CPU_Classifier :=
              US (Get_Name_String (Name (Identifier (CPU))));
            Result.Package_Name := US ("");
         end if;

         Result.Name :=
417
418
419
420
421
           US (Get_Name_String (ATN.Name (ATN.Component_Type_Identifier
               (Corresponding_Declaration (CI)))));

         --  If case of virtual processor, find the physical processor it is
         --  bounded to, and set the values in the taste partition
422
423
424
425
         --  The physical CPU in that case should contain two additional
         --  properties:
         --  ARINC653::Module_Major_Frame (time with unit),
         --  and ARINC653::Module_Schedule
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
         if Get_Category_Of_Component (CPU) = CC_Virtual_Processor then
            declare
               Phy_CPU      : constant Node_Id :=
                 Get_Reference_Property (CPU,
                                         Get_String_Name
                                           ("actual_processor_binding"));
               Phy_CPU_Name : constant String :=
                 Get_Name_String
                   (Name (Identifier (Parent_Subcomponent (Phy_CPU))));
               Phy_CPU_Platform : constant Supported_Execution_Platform :=
                 Get_Execution_Platform (Phy_CPU);
               Phy_CPU_Classifier   : Unbounded_String;
               Phy_CPU_Package_Name : Unbounded_String;
            begin
               --  Build the classifier string (package::...::cpu....)
               Set_Str_To_Name_Buffer ("");
               Get_Name_String (ATN.Name (ATN.Identifier (ATN.Namespace
                                (Corresponding_Declaration (Phy_CPU)))));
               Phy_CPU_Package_Name := US (Get_Name_String (Name_Find));

               Set_Str_To_Name_Buffer ("");
               Get_Name_String (Get_String_Name
                                (To_String (Phy_CPU_Package_Name)));
               Add_Str_To_Name_Buffer ("::");
               Get_Name_String_And_Append (Name (Identifier (Phy_CPU)));

               Phy_CPU_Classifier := US (Get_Name_String (Name_Find));

               Result.VP_Package_Name := Result.Package_Name;
               Result.VP_Name         := Result.CPU_Name;
               Result.VP_Platform     := Result.CPU_Platform;
               Result.VP_Classifier   := Result.CPU_Classifier;
               Result.CPU_Name        := US (Phy_CPU_Name);
               Result.CPU_Platform    := Phy_CPU_Platform;
               Result.CPU_Classifier  := Phy_CPU_Classifier;
               Result.Package_Name    := Phy_CPU_Package_Name;
462
463
464
               Separate_CPU_Family_From_Instance (Phy_CPU,
                                                  Result.CPU_Family,
                                                  Result.CPU_Instance);
Maxime Perrotin's avatar
Maxime Perrotin committed
465
466
               --  Detect the CPU major frame duration and the time
               --  allocation for this specific partition
467
468
469
470
471
472
473
474
475
               declare
                  Major_Frame : constant Time_Type :=
                    Get_POK_Major_Frame (Phy_CPU);
                  Schedule : constant Schedule_Window_Record_Term_Array :=
                    Get_Module_Schedule_Property (Phy_CPU);
               begin
                  if Major_Frame /= Null_Time
                    and then Major_Frame.U = Millisecond
                  then
Maxime Perrotin's avatar
Maxime Perrotin committed
476
477

                     Result.CPU_Total_Time := US (Major_Frame.T'Img);
478
479
                  end if;   -- otherwise, error?
                  for Each of Schedule loop
Maxime Perrotin's avatar
Maxime Perrotin committed
480
481
482
483
484
485
486
                     --  To know if the schedule applies to the current VP,
                     --  we need to compare it with "Corresponding_Declaration
                     --  (Parent_Subcomponent (CPU)
                     if Each.Partition = Corresponding_Declaration
                       (Parent_Subcomponent (CPU))
                     then
                        Result.VP_Duration := US (Each.Duration.T'Img);
487
488
489
490
                     end if;
                  end loop;
               end;

491
492
            end;
         end if;
493
494
495
496
497
498
499
500
501
502
503
504
505
506

         --  Bounded functions
         Processes := First_Node (Subcomponents (Depl));
         while Present (Processes) loop
            P_CI := Corresponding_Instance (Processes);

            if Get_Category_Of_Component (P_CI) = CC_System
              and then Is_Defined_Property (P_CI, "taste::aplc_binding")
            then
               Ref := Get_Reference_Property
                  (P_CI, Get_String_Name ("taste::aplc_binding"));

               if Ref = CI then
                  begin
507
                     Result.Bound_Functions.Insert (Get_Name_String (ATN.Name
508
509
510
511
                        (ATN.Component_Type_Identifier
                            (Corresponding_Declaration (P_CI)))));
                  exception
                     when Assert_Failure =>
512
                        Put_Info ("Detected DV from TASTE version 1.2");
513
                        Result.Bound_Functions.Insert
514
                          (Get_Name_String (Name (Identifier (Processes))));
515
516
517
518
                     when Constraint_Error =>
                        --  If the call to Insert in the set failed
                        Put_Info ("Duplicate bounded function in partition: "
                           & To_String (Result.Name));
519
520
521
522
523
524
525
526
527
528
                  end;
               end if;
            end if;
            Processes := Next_Node (Processes);
         end loop;

         return Result;
      end Parse_Partition;

      function Parse_Node (Depl_View_System : Node_Id) return Taste_Node is
Maxime Perrotin's avatar
Maxime Perrotin committed
529
         Subcos    : Node_Id;
530
531
         CI        : Node_Id;
         Result    : Taste_Node;
532
         Partition : Taste_Partition;
533
      begin
Maxime Perrotin's avatar
Maxime Perrotin committed
534
535
536
537
         Subcos := First_Node (Subcomponents (Depl_View_System));

         while Present (Subcos) loop
            CI := Corresponding_Instance (Subcos);
538
539

            if Get_Category_Of_Component (CI) = CC_Device then
540
               Result.Drivers.Append (Parse_Device (CI));
Maxime Perrotin's avatar
Maxime Perrotin committed
541
542
543
544

            elsif Get_Category_Of_Component (CI) = CC_Memory then
               Result.Memory := Parse_Memory (CI, Depl_View_System);

545
            elsif Get_Category_Of_Component (CI) = CC_Process then
546
               Partition := Parse_Partition (CI, Depl_View_System);
Maxime Perrotin's avatar
Maxime Perrotin committed
547
548
549
               Result.Partitions.Insert
                 (Key      => To_String (Partition.Name),
                  New_Item => Partition);
550
               Result.CPU_Name       := Partition.CPU_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
551
               Result.CPU_Duration   := Partition.CPU_Total_Time;
552
553
               Result.CPU_Family     := Partition.CPU_Family;
               Result.CPU_Instance   := Partition.CPU_Instance;
554
555
               Result.CPU_Platform   := Partition.CPU_Platform;
               Result.CPU_Classifier := Partition.CPU_Classifier;
556
               Result.Ada_Runtime    := Partition.Ada_Runtime;
Maxime Perrotin's avatar
Maxime Perrotin committed
557
558
559
560
561
562
563
564
565
566
567
               Result.Package_Name   := Partition.Package_Name;
               --  Check if there is a Virtual processor, add it to the list
               if Partition.VP_Name /= "" then
                  Result.Virtual_CPUs.Insert
                    (Key      => To_String (Partition.VP_Name),
                     New_Item => (Name         => Partition.VP_Name,
                                  Package_Name => Partition.VP_Package_Name,
                                  Platform     =>
                                    US (Partition.VP_Platform'Img),
                                  Classifier   => Partition.VP_Classifier));
               end if;
568
569
            end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
570
            Subcos := Next_Node (Subcos);
571
572
573
574
         end loop;
         return Result;
      end Parse_Node;

575
   begin
576
      Put_Info ("Parsing deployment view");
577
578
579
580
581
582
583
584
585
586
587
      My_Root_System := Initialize (System);

      if Is_Empty (Subcomponents (My_Root_System)) then
         raise Empty_Deployment_View_Error;
      end if;

      Subs := First_Node (Subcomponents (My_Root_System));

      while Present (Subs) loop
         CI := Corresponding_Instance (Subs);

588
         if Get_Category_Of_Component (CI) = CC_System then  --  Node
589
            if not Is_Empty (Connections (CI)) then
590
               Conns := Conns & Parse_Connections (CI);  --  Checkme
591
592
            end if;

593
            if not Is_Empty (Subcomponents (CI)) then
594
595
596
597
               Node := Parse_Node (CI);
               Node.Name := US (Get_Name_String (Name (Identifier (Subs))));
               Nodes.Insert (Key      => To_String (Node.Name),
                             New_Item => Node);
598
599
            end if;
         elsif Get_Category_Of_Component (CI) = CC_Bus then  --  Bus
600
            Busses.Append (Parse_Bus (Subs, CI));
601
602
603
         else
            raise Deployment_View_Error with "Unknown component found: "
                                         & Get_Category_Of_Component (CI)'Img;
604
605
606
607
608
609
         end if;
         Subs := Next_Node (Subs);
      end loop;

      return DV_AST : constant Complete_Deployment_View :=
        (Nodes          => Nodes,
610
         Connections    => Conns,
611
         Busses         => Busses);
Maxime Perrotin's avatar
Maxime Perrotin committed
612
   end Parse_Deployment_View;
613

Maxime Perrotin's avatar
Maxime Perrotin committed
614
615
616
617
618
619
620
621
622
623
624
625
626
   function Find_Node (Deployment    : Complete_Deployment_View;
                       Function_Name : String) return Option_Node.Option is
   begin
      for Node of Deployment.Nodes loop
         for Partition of Node.Partitions loop
            if Partition.Bound_Functions.Contains (Function_Name) then
               return Option_Node.Just (Node);
            end if;
         end loop;
      end loop;
      return Option_Node.Nothing;
   end Find_Node;

Maxime Perrotin's avatar
Maxime Perrotin committed
627
628
629
630
631
632
633
634
635
636
637
638
   function Find_Partition (Node          : Taste_Node;
                            Function_Name : String)
                            return Option_Partition.Option is
   begin
      for Partition of Node.Partitions loop
         if Partition.Bound_Functions.Contains (Function_Name) then
            return Option_Partition.Just (Partition);
         end if;
      end loop;
      return Option_Partition.Nothing;
   end Find_Partition;

639
   procedure Dump_Nodes (DV : Complete_Deployment_View; Output : File_Type) is
640
641
   begin
      for Each of DV.Nodes loop
642
         Put_Line (Output, "Node : " & To_String (Each.Name));
643
         for Partition of Each.Partitions loop
644
645
646
647
648
            Put_Line (Output, "  |_ Partition        : "
                      & To_String (Partition.Name));
            Put_Line (Output, "    |_ Coverage       : "
                      & Partition.Coverage'Img);
            Put_Line (Output, "    |_ Package        : "
649
                      & To_String (Partition.Package_Name));
650
            Put_Line (Output, "    |_ CPU Name       : "
651
                      & To_String (Partition.CPU_Name));
652
653
654
            Put_Line (Output, "    |_ CPU Platform   : "
                      & Partition.CPU_Platform'Img);
            Put_Line (Output, "    |_ CPU Classifier : "
655
                      & To_String (Partition.CPU_Classifier));
656
657
658
659
660
661
662
663
664
            if Partition.VP_Name /= "" then
               Put_Line (Output, "    |_ VP Name        : "
                         & To_String (Partition.VP_Name));
               Put_Line (Output, "    |_ VP Platform    : "
                         & Partition.VP_Platform'Img);
               Put_Line (Output, "    |_ VP Classifier  : "
                         & To_String (Partition.VP_Classifier));
            end if;

665
            Put (Output, "    |_ Contains       : ");
666
            for Bounded of Partition.Bound_Functions loop
667
               Put (Output, Bounded & " ");
668
            end loop;
669
            New_Line (Output);
670
         end loop;
671
         for Driver of Each.Drivers loop
672
673
            Put_Line (Output, "  |_ Driver : " & To_String (Driver.Name));
            Put_Line (Output, "    |_ Package       : "
674
                      & To_String (Driver.Package_Name));
675
            Put_Line (Output, "    |_ Classifier    : "
676
                      & To_String (Driver.Device_Classifier));
677
            Put_Line (Output, "    |_ Processor     : "
678
                      & To_String (Driver.Associated_Processor_Name));
679
            Put_Line (Output, "    |_ Configuration : "
680
                      & To_String (Driver.Device_Configuration));
681
            Put_Line (Output, "    |_ Bus_Name      : "
682
                      & To_String (Driver.Accessed_Bus_Name));
683
            Put_Line (Output, "    |_ Port_Name     : "
684
                      & To_String (Driver.Accessed_Port_Name));
685
            Put_Line (Output, "    |_ ASN.1 File    : "
686
                      & To_String (Driver.ASN1_Filename));
687
            Put_Line (Output, "    |_ ASN.1 Type    : "
688
                      & To_String (Driver.ASN1_Typename));
689
            Put_Line (Output, "    |_ ASN.1 Module  : "
690
691
                      & To_String (Driver.ASN1_Module));
         end loop;
692
693
694
      end loop;
   end Dump_Nodes;

695
696
   procedure Dump_Connections (DV     : Complete_Deployment_View;
                               Output : File_Type) is
697
698
   begin
      for Each of DV.Connections loop
699
700
701
702
703
704
705
         Put_Line (Output, "Connection on bus : " & To_String (Each.Bus_Name));
         Put_Line (Output, "  |_ Source Node : "
                   & To_String (Each.Source_Node));
         Put_Line (Output, "  |_ Source Port : "
                   & To_String (Each.Source_Port));
         Put_Line (Output, "  |_ Dest Node   : " & To_String (Each.Dest_Node));
         Put_Line (Output, "  |_ Dest Port   : " & To_String (Each.Dest_Port));
706
707
708
      end loop;
   end Dump_Connections;

709
   procedure Dump_Busses (DV : Complete_Deployment_View; Output : File_Type) is
710
711
   begin
      for Each of DV.Busses loop
712
713
714
715
         Put_Line (Output, "Bus : " & To_String (Each.Name));
         Put_Line (Output, "  |_ Package    : "
                   & To_String (Each.AADL_Package));
         Put_Line (Output, "  |_ Classifier : " & To_String (Each.Classifier));
716
         for Prop of Each.Properties loop
717
            Put_Line (Output, "    |_ Property: " & To_String (Prop.Name)
718
719
720
721
722
                      & " = " & To_String (Prop.Value));
         end loop;
      end loop;
   end Dump_Busses;

723
   procedure Debug_Dump (DV : Complete_Deployment_View; Output : File_Type) is
724
   begin
725
726
727
      DV.Dump_Nodes       (Output);
      DV.Dump_Busses      (Output);
      DV.Dump_Connections (Output);
728
729
   end Debug_Dump;

730
end TASTE.Deployment_View;