taste-deployment_view.adb 40 KB
Newer Older
1
2
3
4
--  ******************************* KAZOO  *******************************  --
--  (c) 2017-2021 European Space Agency - maxime.perrotin@esa.int
--  See LICENSE file
--  *********************************************************************** --
5
6
7

--  Deployment View parser

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

25
package body TASTE.Deployment_View is
26

27
   use Ada.Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
28
       Ada.Strings.Fixed,
29
       System.Assertions,
30
       Ocarina.Instances.Queries,
31
       Ocarina.Namet,
32
       --  Ocarina.FE_AADL.Parser,
33
       Ocarina.Backends.Properties.ARINC653,
34
       --  Locations,
35
36
37
38
       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
39

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

50
      Success := Ocarina.Analyzer.Analyze (AADL_Language, Root);
51
52
53
54
55
56
57
58
59
60
61
62
63

      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;

64
65
   function Device_Instance_Name (Driver : Taste_Device_Driver) return String
   is
Rafal Babski's avatar
Rafal Babski committed
66
67
68
69
70
71
72
73
      Dot : constant Natural := Index (Driver.Name, ".");
      Name : constant String := To_String (Driver.Name);
      Device_Name : constant String :=
        (if Dot > 0
           then Name (Name'First .. Dot - 1)
           else "ERROR_MALFORMED_DEVICE_NAME");
   begin
         return Device_Name;
74
   end Device_Instance_Name;
Rafal Babski's avatar
Rafal Babski committed
75

76
77
   function Drivers_To_Template (Drivers : Taste_Drivers.Vector)
                                return Translate_Set is
78
      Device_Names,
79
      Device_Driver_Names,
80
81
82
83
84
85
      Device_Package_Names,
      Device_Classifiers,
      Device_Associated_Processor_Names,
      Device_Configurations,
      Device_Accessed_Bus_Names,
      Device_Accessed_Port_Names,
Maxime Perrotin's avatar
Maxime Perrotin committed
86
      Device_Init_Entrypoints,
87
      Device_Send_Functions,
Maxime Perrotin's avatar
Maxime Perrotin committed
88
      Device_Init_Languages,
89
90
      Device_ASN1_Filenames,
      Device_ASN1_Typenames,
91
92
93
94
95
      Device_ASN1_Modules : Vector_Tag;
   begin
      for Driver of Drivers loop
         declare
         begin
96
97
98
            Device_Names := Device_Names & Driver.Device_Instance_Name;
            Device_Driver_Names := Device_Driver_Names
              & Driver.Driver_Name;
99
100
101
102
            Device_Package_Names := Device_Package_Names
              & Driver.Package_Name;
            Device_Classifiers := Device_Classifiers
              & Driver.Device_Classifier;
Maxime Perrotin's avatar
Maxime Perrotin committed
103
104
            Device_Associated_Processor_Names :=
              Device_Associated_Processor_Names
105
106
107
108
109
110
111
112
113
114
115
116
117
              & Driver.Associated_Processor_Name;
            Device_Configurations := Device_Configurations
              & Driver.Device_Configuration;
            Device_Accessed_Bus_Names :=  Device_Accessed_Bus_Names
              & Driver.Accessed_Bus_Name;
            Device_Accessed_Port_Names := Device_Accessed_Port_Names
              & Driver.Accessed_Port_Name;
            Device_ASN1_Filenames := Device_ASN1_Filenames
              & Driver.ASN1_Filename;
            Device_ASN1_Typenames := Device_ASN1_Typenames
              & Driver.ASN1_Typename;
            Device_ASN1_Modules := Device_ASN1_Modules
              & Driver.ASN1_Module;
Maxime Perrotin's avatar
Maxime Perrotin committed
118
119
            Device_Init_Entrypoints := Device_Init_Entrypoints
              & Driver.Init_Function;
120
121
            Device_Send_Functions := Device_Send_Functions
              & Driver.Send_Function;
Maxime Perrotin's avatar
Maxime Perrotin committed
122
123
            Device_Init_Languages := Device_Init_Languages
              & Driver.Init_Language;
124
125
126
         end;
      end loop;

127
128
129
130
131
132
133
134
135
136
137
138
139
140
      return +Assoc ("Device_Names",     Device_Names)
        & Assoc ("Device_Driver_Names",  Device_Driver_Names)
        & Assoc ("Device_AADL_Pkg",      Device_Package_Names)
        & Assoc ("Device_Classifier",    Device_Classifiers)
        & Assoc ("Device_CPU",           Device_Associated_Processor_Names)
        & Assoc ("Device_Config",        Device_Configurations)
        & Assoc ("Device_Bus_Name",      Device_Accessed_Bus_Names)
        & Assoc ("Device_Port_Name",     Device_Accessed_Port_Names)
        & Assoc ("Device_ASN1_File",     Device_ASN1_Filenames)
        & Assoc ("Device_ASN1_Sort",     Device_ASN1_Typenames)
        & Assoc ("Device_ASN1_Module",   Device_ASN1_Modules)
        & Assoc ("Device_Init",          Device_Init_Entrypoints)
        & Assoc ("Device_Send_Function", Device_Send_Functions)
        & Assoc ("Device_Language",      Device_Init_Languages);
141
142
   end Drivers_To_Template;

143
144
145
146
   ---------------------------
   -- AST Builder Functions --
   ---------------------------

Maxime Perrotin's avatar
Maxime Perrotin committed
147
148
   function Parse_Deployment_View (System : Node_Id;
                                   IV     : Complete_Interface_View)
Maxime Perrotin's avatar
Maxime Perrotin committed
149
                                   return Complete_Deployment_View
150
   is
151
152
      use type Bus_Connections.Vector;

153
      Nodes          : Node_Maps.Map;
154
      Node           : Taste_Node;
155
      Busses         : Taste_Busses.Vector;
156
      Conns          : Bus_Connections.Vector;
157
158
159
160
      My_Root_System : Node_Id;
      Subs           : Node_Id;
      CI             : Node_Id;

Maxime Perrotin's avatar
Maxime Perrotin committed
161
162
      Result_DV      : Complete_Deployment_View;

163
164
      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
165
         Classifier : Name_Id;
166
167
168
169
170
171
172
         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
173
174
            Get_Name_String (ATN.Name (ATN.Identifier (ATN.Namespace
                             (Corresponding_Declaration (Bus)))));
175
176
177
178
179
180
181
182
183
            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
184
            --  No "default" Pkg_Name?
185
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
186
         return Taste_Bus'(Name         =>
187
                             US (Get_Name_String (Name (Identifier (Elem)))),
Maxime Perrotin's avatar
Maxime Perrotin committed
188
189
190
                           AADL_Package => US (Get_Name_String (Pkg_Name)),
                           Classifier   => US (Get_Name_String (Classifier)),
                           Properties   => Properties);
191
      end Parse_Bus;
192

193
194
      procedure Rec_Parse_Connections (AADL_System : Node_Id;
                                       Result : in out Bus_Connections.Vector)
195
196
      is
         use Bus_Connections;
197
         Conn,
198
199
200
201
         Bound_Bus      : Node_Id;
         Bound_Bus_Name : Name_Id;
         Subs,
         Sub_System_CI  : Node_Id;
202
      begin
203
         Conn := First_Node (Connections (AADL_System));
204
         while Present (Conn) loop
205
            Put_Debug ("Parsing Connection " & AIN_Case (Conn));
206
207
208
            --  AADL is confusing because it reverses the meaning of source
            --  and destination. Source is the message receiver (the PI) and
            --  destination is the message sender (the RI)
209
210
211
212
            Bound_Bus := Get_Bound_Bus (Conn, False);
            if Bound_Bus /= No_Node then
               Bound_Bus_Name := Name
                  (Identifier (Parent_Subcomponent (Bound_Bus)));
213
214
215
216
217
               --  The source and destination function/ports are irrelevant
               --  here because they may not be end-to-end connections in
               --  case of a hierarchical structure. All bus connections
               --  must be updated before processing the concurrency view, but
               --  this can be done only using the interface view information.
218
219
220
               --  Put_Debug ("Added bus connnection: ");
               --  Put_Debug (" ... Channel: " & AIN_Case (Conn));
               --  Put_Debug (" ... Bus: " & Get_Name_String (Bound_Bus_Name));
221

222
               Result := Result
223
224
                 & Bus_Connection'(Channel_Name => US (AIN_Case (Conn)),
                                   Bus_Name     =>
225
                                     US (Get_Name_String (Bound_Bus_Name)),
226
                                   others       => <>);
227
228
229
            end if;
            Conn := Next_Node (Conn);
         end loop;
230
231
232
233
234
235
         --  We now check if there are subsystems in the current system
         --  and go recusively to collect all connections bound to a bus
         Subs := First_Node (Subcomponents (AADL_System));
         while Present (Subs) loop
            Sub_System_CI := Corresponding_Instance (Subs);
            if Get_Category_Of_Component (Sub_System_CI) = CC_System then
236
               --  Put_Debug ("Sub node: " & AIN_Case (Sub_System_CI));
237
238
239
240
241
242
243
               if not Is_Empty (Connections (Sub_System_CI)) then
                  Rec_Parse_Connections (Sub_System_CI, Result);
               end if;
            end if;
            Subs := Next_Node (Subs);
         end loop;
      end Rec_Parse_Connections;
244

245
246
247
248
249
250
251
252
253
254
255
256
257
      --  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
258
259
               if not Is_Empty (AIN.Sources (F)) then
                  Src := First_Node (AIN.Sources (F));
260
261
                  if Src /= No_Node then
                     if Item (Src) /= No_Node and then
Maxime Perrotin's avatar
Maxime Perrotin committed
262
263
                        not Is_Empty (AIN.Sources (Item (Src))) and then
                        First_Node (AIN.Sources (Item (Src))) /= No_Node
264
                     then
Maxime Perrotin's avatar
Maxime Perrotin committed
265
                        Src := Item (First_Node (AIN.Sources (Item (Src))));
266
267
268
269
270
271
272
273
274
275
                        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
276
      function Parse_Device (CI : Node_Id) return Taste_Device_Driver is
277
278
279
280
281
282
283
284
         Result                : Taste_Device_Driver;
         Pkg_Name              : Name_Id;
         Accessed_Bus,
         Accessed_Port,
         Device_Implementation,
         Configuration_Data,
         Driver_Init_Data,
         Subco                 : Node_Id;
285
286
287
      begin
         Result.Name := US (Get_Name_String (Name (Identifier (CI))));

Maxime Perrotin's avatar
Maxime Perrotin committed
288
289
290
         --  Get_Implementation returns the "abstract driver" part of the
         --  device, which comes from the "Device_Driver" property of the
         --  instance
291
292
293
294
295
296
297
298
299
300
301
302
303
304
         --  This is an example of this part in AADL:
         --     abstract Driver_GRSPW_Protocol
         --     properties
         --       Deployment::Version  => "0.1beta";
         --       Deployment::Help     => "Help!";
         --       Deployment::Configuration_Type =>
         --        classifier (ocarina_drivers::configuration_type_spacewire);
         --   end Driver_GRSPW_Protocol;
         --
         --   abstract implementation Driver_GRSPW_Protocol.impl
         --   subcomponents
         --      receiver : thread Driver_GRSPW_Protocol_thread_receiver.impl;
         --      sender : subprogram Send;
         --   end Driver_GRSPW_Protocol.impl;
305
306
         Device_Implementation := Get_Implementation (CI);

307
308
309
310
311
312
313
         --  Retrieve the unique driver name
         for P of Get_Properties_Map (CI) loop
            if P.Name = "Deployment::Driver_Name" then
               Result.Driver_Name := P.Value;
            end if;
         end loop;

314
315
         --  *** GET INFORMATION ABOUT DRIVER INITIALIZATION ***
         --  Devices constain this property:
Maxime Perrotin's avatar
Maxime Perrotin committed
316
317
318
319
320
321
322
323
324
325
326
327
328
329
         --  Initialize_Entrypoint => classifier (Native_UART::Initialize);
         --  This subprorgam has two properties of interest, e.g.:
         --     Source_Name => "PolyORB_HI_Drivers_Native_UART.Initialize";
         --     Source_Language => (Ada);
         Driver_Init_Data := Get_Classifier_Property
           (CI, Get_String_Name ("initialize_entrypoint"));

         if Driver_Init_Data /= No_Node and then
           Is_Defined_Property (Driver_Init_Data, "source_name")
         then
            Result.Init_Function :=
              US (Get_Name_String (Get_String_Property
                  (Driver_Init_Data, "source_name")));
         else
330
331
332
            raise Device_Driver_Error with "Driver error ("
                       & To_String (Result.Name)
                       & ") : no initialization function specified in AADL";
Maxime Perrotin's avatar
Maxime Perrotin committed
333
334
335
336
         end if;
         Result.Init_Language := US (Get_Language (Driver_Init_Data));
         Put_Debug ("Driver init: " & To_String (Result.Init_Function));
         Put_Debug ("Driver Language: " & To_String (Result.Init_Language));
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
         --  *** END OF DRIVER INITIALIZATION ***

         --  *** GET INFORMATION ABOUT DRIVER SEND FUNCTION ***
         --  this is defined in the abstract implementation part, but unlike
         --  intiialization, it is not a simple property with the name, we
         --  have to parse subcomponents (see example above) and look for the
         --  one named "sender", which should be a subprogram
         if Present (AIN.Subcomponents (Device_Implementation)) then
            Subco := AIN.First_Node
                (AIN.Subcomponents (Device_Implementation));
            while Present (Subco) loop
               if Get_Name_String (Name (Identifier (Subco))) = "sender" then
                  for P of Get_Properties_Map (Corresponding_Instance (Subco))
                  loop
                     if P.Name = "Source_Name" then
                        Result.Send_Function := P.Value;
                     end if;
                  end loop;
               end if;
               Subco := AIN.Next_Node (Subco);
            end loop;
         end if;

         --  *** END OF DRIVER SEND FUNCTION ***
Maxime Perrotin's avatar
Maxime Perrotin committed
361

362
363
364
365
366
367
368
369
370
         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
371
372
373
               Result.ASN1_Typename :=
                 US (Get_Name_String (Get_String_Property
                    (Configuration_Data, "type_source_name")));
374
375
376
377
               declare
                  ST : constant Name_Array :=
                    Get_Source_Text (Configuration_Data);
               begin
378
379
380
381
382
383
                  --  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;
384
385
                  for Index in ST'Range loop
                     Get_Name_String (ST (Index));
Maxime Perrotin's avatar
Maxime Perrotin committed
386
                     pragma Assert (Name_Len >= 1 and then Name_Len <= 16384);
Maxime Perrotin's avatar
Maxime Perrotin committed
387
388
                     if Tail (Source => Name_Buffer (1 .. Name_Len),
                              Count  => 4) = ".asn"
389
                     then
Maxime Perrotin's avatar
Maxime Perrotin committed
390
391
                        Result.ASN1_Filename :=
                          US (Name_Buffer (1 .. Name_Len));
392
393
394
395
                     end if;
                  end loop;
               end;
            end if;
396
397
398
399
400
401
            if Result.ASN1_Filename = US ("") then
               raise Device_Driver_Error with "Driver error ("
                 & To_String (Result.Name)
                 & ") : Missing ASN.1 configuration file";
            end if;

402
403
404
            if Is_Defined_Property
                 (Configuration_Data, "deployment::asn1_module_name")
            then
405
406
407
               Result.ASN1_Module := US (Get_Name_String
                                                (Get_String_Property
                 (Configuration_Data, "deployment::asn1_module_name")));
408
            else
409
410
               raise Device_Driver_Error with "Driver error ("
                 & To_String (Result.Name) & ") : Missing ASN.1 module name";
411
412
413
414
415
416
417
418
419
420
421
422
423
424
            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;
425
426
427
            --  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));
428
429
430
431
            Set_Str_To_Name_Buffer ("");
            Get_Name_String (Pkg_Name);
            Add_Str_To_Name_Buffer ("::");
            Get_Name_String_And_Append (Name (Identifier (CI)));
432
            Result.Device_Classifier := US (Get_Name_String (Name_Find));
433
         else
434
435
            Result.Device_Classifier :=
              US (Get_Name_String (Name (Identifier (CI))));
436
437
438
439
         end if;

         if Get_Bound_Processor (CI) /= No_Node then
            Set_Str_To_Name_Buffer ("");
440
441
            Result.Associated_Processor_Name := US (Get_Name_String (Name
               (Identifier (Parent_Subcomponent (Get_Bound_Processor (CI))))));
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
         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;
464
465
466
467
468
469
      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);
470
471
      end Parse_Device;

Maxime Perrotin's avatar
Maxime Perrotin committed
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
      --  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;

489
490
491
492
493
494
495
      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;
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
         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;

518
519
520
521
522
523
524
      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;

525
526
527
         --  Gather all user properties
         Result.User_Properties := Get_Properties_Map (CI);

528
529
530
         CPU := Get_Bound_Processor (CI);

         Result.CPU_Name :=
Maxime Perrotin's avatar
Maxime Perrotin committed
531
532
533
           US
             (Get_Name_String (Name (Identifier (Parent_Subcomponent (CPU)))));

534
535
536
         Separate_CPU_Family_From_Instance (CPU,
                                            Result.CPU_Family,
                                            Result.CPU_Instance);
537
538

         Result.CPU_Platform := Get_Execution_Platform (CPU);
539
540
541
542
543
         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;
544
545
546
547
548
549
550

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

552
553
554
555
556
557
558
559
560
561
562
563
564
            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 :=
565
566
567
568
569
           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
570
571
572
573
         --  The physical CPU in that case should contain two additional
         --  properties:
         --  ARINC653::Module_Major_Frame (time with unit),
         --  and ARINC653::Module_Schedule
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
         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;
610
611
612
               Separate_CPU_Family_From_Instance (Phy_CPU,
                                                  Result.CPU_Family,
                                                  Result.CPU_Instance);
Maxime Perrotin's avatar
Maxime Perrotin committed
613
614
               --  Detect the CPU major frame duration and the time
               --  allocation for this specific partition
615
616
617
618
619
620
621
622
623
               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
624
625

                     Result.CPU_Total_Time := US (Major_Frame.T'Img);
626
627
                  end if;   -- otherwise, error?
                  for Each of Schedule loop
Maxime Perrotin's avatar
Maxime Perrotin committed
628
629
630
631
632
633
634
                     --  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);
635
636
637
638
                     end if;
                  end loop;
               end;

639
640
            end;
         end if;
641
642
643
644
645
646
647
648
649
650
651
652
653
654

         --  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
655
                     Result.Bound_Functions.Insert (Get_Name_String (ATN.Name
656
657
658
659
                        (ATN.Component_Type_Identifier
                            (Corresponding_Declaration (P_CI)))));
                  exception
                     when Assert_Failure =>
660
                        Put_Info ("Detected DV from TASTE version 1.2");
661
                        Result.Bound_Functions.Insert
662
                          (Get_Name_String (Name (Identifier (Processes))));
663
664
665
666
                     when Constraint_Error =>
                        --  If the call to Insert in the set failed
                        Put_Info ("Duplicate bounded function in partition: "
                           & To_String (Result.Name));
667
668
669
670
671
672
673
674
675
676
                  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
677
         Subcos    : Node_Id;
678
679
         CI        : Node_Id;
         Result    : Taste_Node;
680
         Partition : Taste_Partition;
681
      begin
Maxime Perrotin's avatar
Maxime Perrotin committed
682
683
684
685
         Subcos := First_Node (Subcomponents (Depl_View_System));

         while Present (Subcos) loop
            CI := Corresponding_Instance (Subcos);
686
687

            if Get_Category_Of_Component (CI) = CC_Device then
688
               Result.Drivers.Append (Parse_Device (CI));
Maxime Perrotin's avatar
Maxime Perrotin committed
689
690
691
692

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

693
            elsif Get_Category_Of_Component (CI) = CC_Process then
694
               Partition := Parse_Partition (CI, Depl_View_System);
Maxime Perrotin's avatar
Maxime Perrotin committed
695
696
697
               Result.Partitions.Insert
                 (Key      => To_String (Partition.Name),
                  New_Item => Partition);
698
               Result.CPU_Name       := Partition.CPU_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
699
               Result.CPU_Duration   := Partition.CPU_Total_Time;
700
701
               Result.CPU_Family     := Partition.CPU_Family;
               Result.CPU_Instance   := Partition.CPU_Instance;
702
703
               Result.CPU_Platform   := Partition.CPU_Platform;
               Result.CPU_Classifier := Partition.CPU_Classifier;
704
               Result.Ada_Runtime    := Partition.Ada_Runtime;
Maxime Perrotin's avatar
Maxime Perrotin committed
705
706
707
708
709
710
711
712
713
714
715
               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;
716
717
            end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
718
            Subcos := Next_Node (Subcos);
719
720
721
722
         end loop;
         return Result;
      end Parse_Node;

723
   begin
724
      Put_Info ("Parsing deployment view");
725
726
727
728
729
730
731
732
733
734
735
      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);

736
         if Get_Category_Of_Component (CI) = CC_System then  --  Node
737
            Put_Debug ("Deployment node name: " & AIN_Case (CI));
738
            if not Is_Empty (Connections (CI)) then
739
740
741
742
743
744
745
746
               --  Parse the connections that are bound to a bus
               --  the connections are found in the interface view, not
               --  in the nodes, because of the Actual_Connection_Binding
               --  property that applies only to interface view connections
               --  Since the interface view can contain nested functions,
               --  the Parse_Connections has to go recursively in them
               --  to find all connection that are bound to a bus
               Rec_Parse_Connections (CI, Conns);
747
748
            end if;

749
            if not Is_Empty (Subcomponents (CI)) then
750
               Node      := Parse_Node (CI);
751
               Node.Name := US (Get_Name_String (Name (Identifier (Subs))));
Maxime Perrotin's avatar
Maxime Perrotin committed
752
753
754
755
               if Node.Name /= "interfaceview" then
                  Nodes.Insert (Key      => To_String (Node.Name),
                                New_Item => Node);
               end if;
756
757
            end if;
         elsif Get_Category_Of_Component (CI) = CC_Bus then  --  Bus
758
            Busses.Append (Parse_Bus (Subs, CI));
759
760
761
         else
            raise Deployment_View_Error with "Unknown component found: "
                                         & Get_Category_Of_Component (CI)'Img;
762
763
764
765
         end if;
         Subs := Next_Node (Subs);
      end loop;

Maxime Perrotin's avatar
Maxime Perrotin committed
766
767
768
769
770
771
772
773
      Result_DV := (Nodes          => Nodes,
                    Connections    => Conns,
                    Busses         => Busses);

      Result_DV.Fix_Bus_Connections (IV);

      return Result_DV;

Maxime Perrotin's avatar
Maxime Perrotin committed
774
   end Parse_Deployment_View;
775

Maxime Perrotin's avatar
Maxime Perrotin committed
776
777
778
779
780
781
782
783
784
785
786
787
788
   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
789
790
791
792
793
794
795
796
797
798
799
800
   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;

801
802
   procedure Fix_Bus_Connections (DV : in out Complete_Deployment_View;
                                  IV : Complete_Interface_View) is
Maxime Perrotin's avatar
Maxime Perrotin committed
803
      use Option_Node;
804
805
806
807
808
809
   begin
      --  We must find the channel referenced in the bus connection
      --  among all the connections of the interface view to retrieve
      --  the end-to-end connections and set the source/dest port properly,
      --  i.e. not referencing any nesting functions (which are not mapped
      --  to any partition)
Maxime Perrotin's avatar
Maxime Perrotin committed
810
      Put_Debug ("Computing end-to-end connections (for bus bindings)");
811
812
813
814
      for C_DV : Bus_Connection of DV.Connections loop
         for C_IV : Connection of IV.Connections loop
            for Channel of C_IV.Channels loop
               if Channel = C_DV.Channel_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
815
816
817
818
819
                  if Find_Node (DV, To_String (C_IV.Caller))
                    = Find_Node (DV, To_String (C_IV.Callee))
                  then
                     Put_Debug ("No bus connection between "
                             & To_String (C_IV.Caller)
820
                             & "." & To_String (C_IV.RI_Name)
Maxime Perrotin's avatar
Maxime Perrotin committed
821
                             & " and " & To_String (C_IV.Callee)
822
                             & "." & To_String (C_IV.PI_Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
823
824
825
826
827
828
829
830
                  else
                     Put_Debug ("Bus connection: " & To_String (C_IV.Caller)
                                & "." & To_String (C_IV.RI_Name)
                                & " -> " & To_String (C_IV.Callee)
                                & "." & To_String (C_IV.PI_Name));

                     --  Update the information in the deployment view
                     C_DV.Source_Function := C_IV.Caller;
Maxime Perrotin's avatar
Maxime Perrotin committed
831
                     C_DV.Source_Port     := C_IV.Callee & "_" & C_IV.RI_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
832
833
834
                     C_DV.Dest_Function   := C_IV.Callee;
                     C_DV.Dest_Port       := C_IV.PI_Name;
                  end if;
835
836
837
838
839
840
               end if;
            end loop;
         end loop;
      end loop;
   end Fix_Bus_Connections;

841
   procedure Dump_Nodes (DV : Complete_Deployment_View; Output : File_Type) is
842
843
   begin
      for Each of DV.Nodes loop
844
         Put_Line (Output, "Node : " & To_String (Each.Name));
845
         for Partition of Each.Partitions loop
846
847
848
849
850
            Put_Line (Output, "  |_ Partition        : "
                      & To_String (Partition.Name));
            Put_Line (Output, "    |_ Coverage       : "
                      & Partition.Coverage'Img);
            Put_Line (Output, "    |_ Package        : "
851
                      & To_String (Partition.Package_Name));
852
            Put_Line (Output, "    |_ CPU Name       : "
853
                      & To_String (Partition.CPU_Name));
854
855
856
            Put_Line (Output, "    |_ CPU Platform   : "
                      & Partition.CPU_Platform'Img);
            Put_Line (Output, "    |_ CPU Classifier : "
857
                      & To_String (Partition.CPU_Classifier));
858
859
860
861
862
863
864
865
866
            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;

867
            Put (Output, "    |_ Contains       : ");
868
            for Bounded of Partition.Bound_Functions loop
869
               Put (Output, Bounded & " ");
870
            end loop;
871
            New_Line (Output);
872
         end loop;
873
         for Driver of Each.Drivers loop
874
            Put_Line (Output, "  |_ Driver : " & To_String (Driver.Name));
875
876
            Put_Line (Output, "    |_ Name          : "
                      & To_String (Driver.Driver_Name));
877
            Put_Line (Output, "    |_ Package       : "
878
                      & To_String (Driver.Package_Name));
879
            Put_Line (Output, "    |_ Classifier    : "
880
                      & To_String (Driver.Device_Classifier));
881
            Put_Line (Output, "    |_ Processor     : "
882
                      & To_String (Driver.Associated_Processor_Name));
883
            Put_Line (Output, "    |_ Configuration : "
884
                      & To_String (Driver.Device_Configuration));
885
            Put_Line (Output, "    |_ Bus_Name      : "
886
                      & To_String (Driver.Accessed_Bus_Name));
887
            Put_Line (Output, "    |_ Port_Name     : "
888
                      & To_String (Driver.Accessed_Port_Name));
889
            Put_Line (Output, "    |_ ASN.1 File    : "
890
                      & To_String (Driver.ASN1_Filename));
891
            Put_Line (Output, "    |_ ASN.1 Type    : "
892
                      & To_String (Driver.ASN1_Typename));
893
            Put_Line (Output, "    |_ ASN.1 Module  : "
894
                      & To_String (Driver.ASN1_Module));
Maxime Perrotin's avatar
Maxime Perrotin committed
895
896
            Put_Line (Output, "    |_ Init function : "
                      & To_String (Driver.Init_Function));
897
898
            Put_Line (Output, "    |_ Init function : "
                      & To_String (Driver.Send_Function));
Maxime Perrotin's avatar
Maxime Perrotin committed
899
900
            Put_Line (Output, "    |_ Language : "
                      & To_String (Driver.Init_Language));
901
         end loop;
902
903
904
      end loop;
   end Dump_Nodes;

905
906
   procedure Dump_Connections (DV     : Complete_Deployment_View;
                               Output : File_Type) is
907
908
   begin
      for Each of DV.Connections loop
909
         Put_Line (Output, "Connection on bus : " & To_String (Each.Bus_Name));
910
911
         Put_Line (Output, "  |_ Source Function : "
                   & To_String (Each.Source_Function));
912
913
         Put_Line (Output, "  |_ Source Port : "
                   & To_String (Each.Source_Port));
914
915
         Put_Line (Output, "  |_ Dest Function : "
                   & To_String (Each.Dest_Function));
916
         Put_Line (Output, "  |_ Dest Port   : " & To_String (Each.Dest_Port));
917
918
919
      end loop;
   end Dump_Connections;

920
   procedure Dump_Busses (DV : Complete_Deployment_View; Output : File_Type) is
921
922
   begin
      for Each of DV.Busses loop
923
924
925
926
         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));
927
         for Prop of Each.Properties loop
928
            Put_Line (Output, "    |_ Property: " & To_String (Prop.Name)
929
930
931
932
933
                      & " = " & To_String (Prop.Value));
         end loop;
      end loop;
   end Dump_Busses;

934
   procedure Debug_Dump (DV : Complete_Deployment_View; Output : File_Type) is
935
   begin
936
937
938
      DV.Dump_Nodes       (Output);
      DV.Dump_Busses      (Output);
      DV.Dump_Connections (Output);
939
940
   end Debug_Dump;

941
end TASTE.Deployment_View;