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

--  Interface View parser

7
with Ada.Exceptions,
8
     Ocarina.Instances.Queries,
Maxime Perrotin's avatar
Maxime Perrotin committed
9
10
11
     Ocarina.Analyzer,
     Ocarina.Options,
     Ocarina.Instances,
12
13
     Ocarina.Backends.Properties,
     Ocarina.ME_AADL.AADL_Tree.Nodes,
14
     Ocarina.ME_AADL.AADL_Instances.Nodes,
Maxime Perrotin's avatar
Maxime Perrotin committed
15
     Ocarina.Namet,
16
     Ocarina.ME_AADL.AADL_Tree.Nutils,
17
     Ocarina.ME_AADL.AADL_Instances.Nutils,
18
19
20
     Ocarina.ME_AADL.AADL_Instances.Entities,
     Ocarina.Backends.Utils;

21
package body TASTE.Interface_View is
22

23
   use Ada.Exceptions,
24
25
       Ocarina.Instances.Queries,
       Ocarina.Namet,
26
       --  Ocarina.Analyzer,
Maxime Perrotin's avatar
Maxime Perrotin committed
27
28
       Ocarina.Options,
       Ocarina.Instances,
29
       Ocarina.Backends.Properties,
30
31
32
33
34
35
       Ocarina.ME_AADL.AADL_Instances.Nodes,
       Ocarina.ME_AADL.AADL_Instances.Nutils,
       Ocarina.ME_AADL.AADL_Instances.Entities,
       Ocarina.ME_AADL,
       Ocarina.Backends.Utils;

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
   package ATN  renames Ocarina.ME_AADL.AADL_Tree.Nodes;
   package ATNU renames Ocarina.ME_AADL.AADL_Tree.Nutils;

   ------------------------------
   -- Get_Language (as string) --
   ------------------------------

   function Get_Language (E : Node_Id) return String is
      Source_Property : constant Name_Id :=
         Get_String_Name ("source_language");
   begin
      if Is_Defined_List_Property (E, Source_Property) then
         declare
            Source_Language_List : constant List_Id :=
               Get_List_Property (E, Source_Property);
         begin
            if ATNU.Length (Source_Language_List) > 1 then
               raise Interface_Error with "Cannot use more than one language";
            end if;

            return Get_Name_String
               (ATN.Name
                  (ATN.Identifier (ATN.First_Node (Source_Language_List))));
         end;
      else
         return "None";
      end if;
   end Get_Language;

65
66
67
68
69
70
71
72
73
74
75
76
77
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
111
112
113
114
115
116
117
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
   ----------------------------
   -- Get_RCM_Operation_Kind --
   ----------------------------

   function Get_RCM_Operation_Kind
     (E : Node_Id) return Supported_RCM_Operation_Kind
   is
      RCM_Operation_Kind_N : Name_Id;
      RCM_Operation_Kind : constant Name_Id :=
          Get_String_Name ("taste::rcmoperationkind");
      Unprotected_Name   : constant Name_Id := Get_String_Name ("unprotected");
      Protected_Name     : constant Name_Id := Get_String_Name ("protected");
      Cyclic_Name        : constant Name_Id := Get_String_Name ("cyclic");
      Sporadic_Name      : constant Name_Id := Get_String_Name ("sporadic");
      Any_Name           : constant Name_Id := Get_String_Name ("any");
   begin
      if Is_Defined_Enumeration_Property (E, RCM_Operation_Kind) then
         RCM_Operation_Kind_N :=
            Get_Enumeration_Property (E, RCM_Operation_Kind);

         if RCM_Operation_Kind_N = Unprotected_Name then
            return Unprotected_Operation;

         elsif RCM_Operation_Kind_N = Protected_Name then
            return Protected_Operation;

         elsif RCM_Operation_Kind_N = Cyclic_Name then
            return Cyclic_Operation;

         elsif RCM_Operation_Kind_N = Sporadic_Name then
            return Sporadic_Operation;

         elsif RCM_Operation_Kind_N = Any_Name then
            return Any_Operation;
         end if;
      end if;
      raise No_RCM_Error;
   end Get_RCM_Operation_Kind;

   -----------------------
   -- Get_RCM_Operation --
   -----------------------

   function Get_RCM_Operation (E : Node_Id) return Node_Id is
      RCM_Operation : constant Name_Id :=
          Get_String_Name ("taste::rcmoperation");
   begin
      if Is_Subprogram_Access (E) then
         return Corresponding_Instance (E);
      else
         if Is_Defined_Property (E, RCM_Operation) then
            return Get_Classifier_Property (E, RCM_Operation);
         else
            return No_Node;
         end if;
      end if;
   end Get_RCM_Operation;

   --------------------
   -- Get_RCM_Period --
   --------------------

   function Get_RCM_Period (D : Node_Id) return Unsigned_Long_Long is
      RCM_Period : constant Name_Id := Get_String_Name ("taste::rcmperiod");
   begin
      if Is_Defined_Integer_Property (D, RCM_Period) then
         return Get_Integer_Property (D, RCM_Period);
      else
         return 0;
      end if;
   end Get_RCM_Period;

   --------------------------
   -- Get_Ada_Package_Name --
   --------------------------

   function Get_Ada_Package_Name (D : Node_Id) return Name_Id is
      Ada_Package_Name : constant Name_id :=
         Get_String_Name ("taste::ada_package_name");
   begin
      return Get_String_Property (D, Ada_Package_Name);
   end Get_Ada_Package_Name;

   -------------------------------
   -- Get_Ellidiss_Tool_Version --
   -------------------------------

   function Get_Ellidiss_Tool_Version (D : Node_Id) return Name_Id is
      Ellidiss_Tool_Version : constant Name_id :=
         Get_String_Name ("taste::version");
   begin
      return Get_String_Property (D, Ellidiss_Tool_Version);
   end Get_Ellidiss_Tool_Version;

   ---------------------------
   -- Get ASN.1 Module name --
   ---------------------------

   function Get_ASN1_Module_Name (D : Node_Id) return String is
Maxime Perrotin's avatar
Maxime Perrotin committed
164
      id : Name_Id;
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
      ASN1_Module : constant Name_id :=
         Get_String_Name ("deployment::asn1_module_name");
   begin
      if Is_Defined_String_Property (D, ASN1_Module) then
         id := Get_String_Property (D, ASN1_Module);
         return Get_Name_String (id);
      else
         return Get_Name_String (Get_String_Name ("nomodule"));
      end if;
   end Get_ASN1_Module_Name;

   -----------------------
   -- Get_ASN1_Encoding --
   -----------------------

   function Get_ASN1_Encoding (E : Node_Id) return Supported_ASN1_Encoding is
      ASN1_Encoding_N : Name_Id;
      ASN1_Encoding : constant Name_Id := Get_String_Name ("taste::encoding");
      Native_Name   : constant Name_Id := Get_String_Name ("native");
      UPER_Name     : constant Name_Id := Get_String_Name ("uper");
      ACN_Name      : constant Name_Id := Get_String_Name ("acn");
   begin
      if Is_Defined_Enumeration_Property (E, ASN1_Encoding) then
         ASN1_Encoding_N := Get_Enumeration_Property (E, ASN1_Encoding);

         if ASN1_Encoding_N = Native_Name then
            return Native;

         elsif ASN1_Encoding_N = UPER_Name then
            return UPER;

         elsif ASN1_Encoding_N = ACN_Name then
            return ACN;
         end if;
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
200
      raise Interface_Error with "ASN1 Encoding not set";
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
      return Default;
   end Get_ASN1_Encoding;

   -------------------------
   -- Get_ASN1_Basic_Type --
   -------------------------

   function Get_ASN1_Basic_Type (E : Node_Id) return Supported_ASN1_Basic_Type
   is
      ASN1_Basic_Type  : constant Name_Id :=
                               Get_String_Name ("taste::asn1_basic_type");
      Sequence_Name    : constant Name_Id := Get_String_Name ("asequence");
      SequenceOf_Name  : constant Name_Id := Get_String_Name ("asequenceof");
      Enumerated_Name  : constant Name_Id := Get_String_Name ("aenumerated");
      Set_Name         : constant Name_Id := Get_String_Name ("aset");
      SetOf_Name       : constant Name_Id := Get_String_Name ("asetof");
      Integer_Name     : constant Name_Id := Get_String_Name ("ainteger");
      Boolean_Name     : constant Name_Id := Get_String_Name ("aboolean");
      Real_Name        : constant Name_Id := Get_String_Name ("areal");
      OctetString_Name : constant Name_Id := Get_String_Name ("aoctetstring");
      Choice_Name      : constant Name_Id := Get_String_Name ("achoice");
      String_Name      : constant Name_Id := Get_String_Name ("astring");
      ASN1_Basic_Type_N : Name_Id;
   begin
      if Is_Defined_Enumeration_Property (E, ASN1_Basic_Type) then
         ASN1_Basic_Type_N := Get_Enumeration_Property (E, ASN1_Basic_Type);

         if ASN1_Basic_Type_N = Sequence_Name then
            return ASN1_Sequence;

         elsif ASN1_Basic_Type_N = SequenceOf_Name then
            return ASN1_SequenceOf;

         elsif ASN1_Basic_Type_N = Enumerated_Name then
            return ASN1_Enumerated;

         elsif ASN1_Basic_Type_N = Set_Name then
            return ASN1_Set;

         elsif ASN1_Basic_Type_N = SetOf_Name then
            return ASN1_SetOf;

         elsif ASN1_Basic_Type_N = Integer_Name then
            return ASN1_Integer;

         elsif ASN1_Basic_Type_N = Boolean_Name then
            return ASN1_Boolean;

         elsif ASN1_Basic_Type_N = Real_Name then
            return ASN1_Real;

         elsif ASN1_Basic_Type_N = OctetString_Name then
            return ASN1_OctetString;

         elsif ASN1_Basic_Type_N = Choice_Name then
            return ASN1_Choice;

         elsif ASN1_Basic_Type_N = String_Name then
            return ASN1_String;

         else
            raise Program_Error with "Undefined choice "
              & Get_Name_String (ASN1_Basic_Type_N);
         end if;
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
266
      raise Interface_Error with "ASN.1 Basic type undefined!";
267
268
269
270
271
272
273
      return ASN1_Unknown;
   end Get_ASN1_Basic_Type;

   ----------------------------------------------------------------
   -- Get Optional Worse Case Execution Time (Upper bound in ms) --
   ----------------------------------------------------------------

Maxime Perrotin's avatar
Maxime Perrotin committed
274
   function Get_Upper_WCET (Func : Node_Id) return Option_ULL.Option is
275
276
277
278
279
280
281
      (if Is_Subprogram_Access (Func) and then Sources (Func) /= No_List
         and then AIN.First_Node (Sources (Func)) /= No_Node
         and then Get_Execution_Time (Corresponding_Instance (AIN.Item
                                           (AIN.First_Node (Sources (Func)))))
                           /= Empty_Time_Array
      then Just (To_Milliseconds (Get_Execution_Time (Corresponding_Instance
                             (AIN.Item (AIN.First_Node (Sources (Func)))))(1)))
Maxime Perrotin's avatar
Maxime Perrotin committed
282
         else Option_ULL.Nothing);
283
284
285
286
287

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

Maxime Perrotin's avatar
Maxime Perrotin committed
288
   function Parse_Interface_View (Interface_Root : Node_Id)
Maxime Perrotin's avatar
Maxime Perrotin committed
289
290
                                  return Complete_Interface_View
   is
291
292
293
294
      --  use type Functions.Vector;
      use type Channels.Vector;
      use type Ctxt_Params.Vector;
      use type Parameters.Vector;
295
      --  use type Connection_Maps.Map;
Maxime Perrotin's avatar
Maxime Perrotin committed
296
297
      System            : Node_Id;
      Success           : Boolean;
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
      Functions         : Function_Maps.Map;
      Routes_Map        : Connection_Maps.Map;
      Current_Function  : Node_Id;

      --  Parse a connection
      function Parse_Connection (Conn : Node_Id) return Optional_Connection is
         use Option_Connection;
         Caller  : constant Node_Id := AIN.Item (AIN.First_Node
                                         (AIN.Path (AIN.Destination (Conn))));
         Callee  : constant Node_Id := AIN.Item (AIN.First_Node
                                         (AIN.Path (AIN.Source (Conn))));
         PI_Name : Name_Id;  --  None in case of cyclic interface
         RI_Name : constant Name_Id := Get_Interface_Name
                              (Get_Referenced_Entity (AIN.Destination (Conn)));
      begin
         --  If RI_Name has no value it means the interface view misses the
         --  AADL property "TASTE::InterfaceName". Not supported.
Maxime Perrotin's avatar
Maxime Perrotin committed
315
316
317
318
319
320
         if RI_Name = No_Name then
            raise Interface_Error with "Interface view contains errors "
              & "(Missing TASTE::InterfaceName properties)"
              & ASCII.CR & ASCII.LF
              & "        Try updating it with taste-edit-project";
         end if;
321
322
323
324
325

         --  Filter out connections if the PI is cyclic (not a connection!)
         if Get_RCM_Operation_Kind
           (Get_Referenced_Entity (AIN.Destination (Conn))) = Cyclic_Operation
         then
Maxime Perrotin's avatar
Maxime Perrotin committed
326
            return Option_Connection.Nothing;
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
         end if;

         PI_Name := Get_Interface_Name
                                  (Get_Referenced_Entity (AIN.Source (Conn)));

         return Just (Connection'(Caller =>
           (if Kind (Caller) = K_Subcomponent_Access_Instance then US ("_env")
            else US (AIN_Case (Caller))),
                            Callee =>
           (if Kind (Callee) = K_Subcomponent_Access_Instance then US ("_env")
            else US (AIN_Case (Callee))),
                            PI_Name => US (Get_Name_String (PI_Name)),
                            RI_Name => US (Get_Name_String (RI_Name))));
      end Parse_Connection;

      --  Create a vector of connections for a given system
      --  This vector will then be filtered to connect end-to-end functions
      --  once the system is flattened
      function Parse_System_Connections (System : Node_Id)
         return Channels.Vector
      is
         use Option_Connection;
         Conn     : Node_Id;
         Result   : Channels.Vector;
         Opt_Conn : Optional_Connection;
      begin
         if Present (AIN.Connections (System)) then
            Conn := AIN.First_Node (AIN.Connections (System));
            while Present (Conn) loop
               Opt_Conn := Parse_Connection (Conn);
               if Opt_Conn.Has_Value then
                  Result := Result & Opt_Conn.Unsafe_Just;
               end if;
               Conn := AIN.Next_Node (Conn);
            end loop;
         end if;
         return Result;
      end Parse_System_Connections;

      --  Parse an individual context parameter
      function Parse_CP (Subco : Node_Id) return Context_Parameter is
         CP_ASN1 : constant Node_Id    := Corresponding_Instance (Subco);
         NA      : constant Name_Array := Get_Source_Text (CP_ASN1);
      begin
         return Context_Parameter'(
            Name           => US (AIN_Case (Subco)),
            Sort           => US (Get_Name_String
                                        (Get_Type_Source_Name (CP_ASN1))),
            Default_Value  => US (Get_Name_String (Get_String_Property
                                        (CP_ASN1, "taste::fs_default_value"))),
            ASN1_Module    => US (Get_ASN1_Module_Name (CP_ASN1)),
            ASN1_File_Name => (if NA'Length > 0 then
                               Just (US (Get_Name_String (NA (1))))
Maxime Perrotin's avatar
Maxime Perrotin committed
380
                               else Option_UString.Nothing));
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
      end Parse_CP;

      --  Parse a single parameter of an interface
      --  * Name                (Unbounded string)
      --  * Sort                (Unbounded string)
      --  * ASN1_Module         (Unbounded string)
      --  * ASN1_Basic_Type     (Supported_ASN1_Basic_Type)
      --  * ASN1_File_Name      (Unbounded string)
      --  * Encoding            (Supported_ASN1_Encoding)
      --  * Direction           (Parameter_Direction: IN or OUT)
      function Parse_Parameter (Param_I : Node_Id) return ASN1_Parameter is
         Asntype : constant Node_Id := Corresponding_Instance (Param_I);
      begin
         return ASN1_Parameter'(
             Name => US (AIN_Case (Param_I)),
             Sort => US (Get_Name_String (Get_Type_Source_Name (Asntype))),
             ASN1_Module =>
                 US (Get_Name_String (Get_Ada_Package_Name (Asntype))),
             ASN1_Basic_Type => Get_ASN1_Basic_Type (Asntype),
             ASN1_File_Name =>
                US (Get_Name_String (Get_Source_Text (Asntype)(1))),
             Encoding => Get_ASN1_Encoding (Param_I),
             Direction => (if AIN.Is_In (Param_I)
                           then param_in else param_out));
      end Parse_Parameter;

      --  Parse a function interface :
      --  * Name                (Unbounded string)
      --  * Params              (Parameters.Vector)
      --  * RCM                 (Supported_RCM_Operation_Kind)
      --  * Period_Or_MIAT      (Unsigned long long)
      --  * WCET_ms             (Optional unsigned long long)
      --  * Queue_Size          (Optional unsigned long long)
      --  * User_Properties     (Property_Maps.Map)
      function Parse_Interface (If_I : Node_Id) return Taste_Interface is
         Name    : constant Name_Id := Get_Interface_Name (If_I);
         CI      : constant Node_Id := Corresponding_Instance (If_I);
         Result  : Taste_Interface;
         Sub_I   : constant Node_Id := Get_RCM_Operation (If_I);
         Param_I : Node_Id;
      begin
         pragma Assert (Present (Sub_I));
         --  Keep compatibility with 1.2 models for the interface name
         Result.Name := (if Name = No_Name then US (AIN_Case (If_I)) else
                         US (Get_Name_String (Name)));
         Result.Queue_Size := (if Kind (If_I) = K_Subcomponent_Access_Instance
                               and then Is_Defined_Property
                                   (CI, "taste::associated_queue_size")
                               then Just (Get_Integer_Property
                                   (CI, " taste::associated_queue_size"))
Maxime Perrotin's avatar
Maxime Perrotin committed
431
                               else Option_ULL.Nothing);
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
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
         Result.RCM := Get_RCM_Operation_Kind (If_I);
         Result.Period_Or_MIAT := Get_RCM_Period (If_I);
         Result.WCET_ms := Get_Upper_WCET (If_I);
         Result.User_Properties := Get_Properties_Map (If_I);
         --  Parameters:
         if not Is_Empty (AIN.Features (Sub_I)) then
            Param_I := AIN.First_Node (AIN.Features (Sub_I));
            while Present (Param_I) loop
               if Kind (Param_I) = K_Parameter_Instance then
                  Result.Params := Result.Params & Parse_Parameter (Param_I);
               end if;
               Param_I := AIN.Next_Node (Param_I);
            end loop;
         end if;
         return Result;
      exception
         when No_RCM_Error =>
            raise Interface_Error with "Interface " & To_String (Result.Name)
                                       & " has no kind "
                                       & "(periodic, sporadic ...)";
      end Parse_Interface;

      --  Helper function - return the context name above the current one
      --  Needed to resolve the connections to "_env".
      function Parent_Context (Context : String) return String is
      begin
         for Each in Routes_Map.Iterate loop
            if Context /= Connection_Maps.Key (Each) then
               for Conn of Connection_Maps.Element (Each) loop
                  if Conn.Caller = Context or Conn.Callee = Context then
                     return Connection_Maps.Key (Each);
                  end if;
               end loop;
            end if;
         end loop;
         return "ERROR";
      end Parent_Context;

      --  Recursive function making jumps to find the provided interface
      --  connected to a required interface. It returns a Remote Entity,
      --  which contains the name of the remote PI and the name of the function
      function Rec_Jump (From : String; RI : String;
                         Going_Out : Boolean := False) return Remote_Entity is
         Context     : constant String :=
           (if Functions.Contains (Key => From)
            then To_String (Functions.Element (Key => From).Context)
            else (if not Going_Out then From else Parent_Context (From)));
         Source      : constant String :=
           (if Context /= From then From else "_env");
         Result      : Remote_Entity := (US ("Not found!"), US ("Not found!"));
         Connections : Channels.Vector;
         Set_Going_Out : Boolean := False;
      begin
         --  Note: There is a limitation in the interface view when there are
         --  nested functions. At the border of a nested function, there can
         --  be only ONE function of a given name. This means that it is
         --  impossible to have two PIs with the same name, even in different
         --  functions, if they are located in the same nested context.
         --  * This is NOT RIGHT and should be fixed by Ellidiss *

         --  Retrieve the list of connections of the source function context
         Connections := Routes_Map.Element (Key => Context);
         for Each of Connections loop
            if Each.Caller = Source and Each.RI_Name = US (RI) then
               --  Found the connection in the current context
               --  Now recurse if the callee is a nested block,
               --  and return otherwise (if destination is a function)
               if Each.Callee = "_env" then
                  Set_Going_Out := True;
               end if;

               Result :=
                 (if Functions.Contains (Key => To_String (Each.Callee))
                  then (Function_Name  => Each.Callee,
                        Interface_Name => Each.PI_Name)
                  else Rec_Jump (From      => (if not Set_Going_Out
                                               then To_String (Each.Callee)
                                               else Context),
                                 Going_Out => Set_Going_Out,
                                 RI        => To_String (Each.PI_Name)));
            end if;

            exit when Each.Caller = Source and Each.RI_Name = US (RI);
         end loop;
         return Result;
      end Rec_Jump;

      --  Parse the following content of a single function :
      --  * Name
      --  * Language
      --  * Zip File
      --  * Context Parameters
      --  * User Properties (from TASTE_IV_Properties.aadl)
      --  * Timers
      --  * Provided and Required Interfaces
      function Parse_Function (Prefix : String;
                               Name   : String;
                               Inst   : Node_Id) return Taste_Terminal_Function
      is
         Result      : Taste_Terminal_Function;
         --  To get the optional zip filename where user code is stored:
         Source_Text : constant Name_Array := Get_Source_Text (Inst);
Maxime Perrotin's avatar
Maxime Perrotin committed
534
         Zip_Id      : Name_Id;
535
536
537
538
539
540
541
542
         --  To get the context parameters
         Subco       : Node_Id;
         --  To get the provided and required interfaces
         PI_Or_RI    : Node_Id;
         Iface       : Taste_Interface;
      begin
         Result.Name          := US (Name);
         Result.Full_Prefix   := (if Prefix'Length > 0 then Just (US (Prefix))
Maxime Perrotin's avatar
Maxime Perrotin committed
543
                                 else Option_UString.Nothing);
544
545
         --  Result.Language      := Get_Source_Language (Inst);
         Result.Language      := US (Get_Language (Inst));
546
547
548
549
         if Source_Text'Length /= 0 then
            Zip_Id          := Source_Text (1);
            Result.Zip_File := Just (US (Get_Name_String (Zip_Id)));
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
550
         --  Parse context parameters (including timers)
551
552
553
554
555
         if Present (AIN.Subcomponents (Inst)) then
            Subco := AIN.First_Node (AIN.Subcomponents (Inst));
            while Present (Subco) loop
               case Get_Category_Of_Component (Subco) is
                  when CC_Data =>
Maxime Perrotin's avatar
Maxime Perrotin committed
556
557
558
559
560
561
562
                     declare
                        CP : constant Context_Parameter := Parse_CP (Subco);
                        use String_Vectors;
                     begin
                        if CP.Sort = "Timer" then
                           Result.Timers := Result.Timers
                                            & To_String (CP.Name);
563
564
565
566
                        elsif CP.Sort = "Taste-directive" then
                           Result.Directives := Result.Directives & CP;
                        elsif CP.Sort = "Simulink-Tunable-Parameter" then
                           Result.Simulink := Result.Simulink & CP;
Maxime Perrotin's avatar
Maxime Perrotin committed
567
                        else
568
                           --  Standard Context Parameter (for C/C++/Ada)
Maxime Perrotin's avatar
Maxime Perrotin committed
569
570
571
                           Result.Context_Params := Result.Context_Params & CP;
                        end if;
                     end;
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
                  when others =>
                     null;
               end case;
               Subco := AIN.Next_Node (Subco);
            end loop;
         end if;
         --  Parse provided and required interfaces
         if Present (AIN.Features (Inst)) then
            PI_Or_RI := AIN.First_Node (AIN.Features (Inst));
            while Present (PI_Or_RI) loop
               Iface := Parse_Interface (PI_Or_RI);
               Iface.Parent_Function := Result.Name;
               if AIN.Is_Provided (PI_Or_RI) then
                  Result.Provided.Insert (Key      => To_String (Iface.Name),
                                          New_Item => Iface);
               else
                  Result.Required.Insert (Key      => To_String (Iface.Name),
                                          New_Item => Iface);
               end if;
               PI_Or_RI := AIN.Next_Node (PI_Or_RI);
            end loop;
         end if;
         Result.User_Properties := Get_Properties_Map (Inst);
595
596
597
598
599
600
601
602
603
604
605
606
607
608

         --  Check User properties for first-class attributes
         --  Currently: component type and instance
         for Each of Result.User_Properties loop
            if Each.Name = "TASTE_IV_Properties::is_Component_Type" and then
               Each.Value = "true"
            then
               Result.Is_Type := True;
            end if;
            if Each.Name = "TASTE_IV_Properties::is_instance_of" then
               Result.Instance_Of := Just (Each.Value);
            end if;
         end loop;

609
610
611
612
613
614
615
616
617
618
         return Result;
      exception
         when Error : Interface_Error =>
            raise Function_Error with "Function " & To_String (Result.Name)
                                      & " : " & Exception_Message (Error);
      end Parse_Function;

      --  Recursive parsing of a system made of nested functions (TASTE v2)
      function Rec_Function (Prefix : String  := "";
                             Context : String := "_Root";
Maxime Perrotin's avatar
Maxime Perrotin committed
619
620
621
622
                             Func   : Node_Id) return Boolean
        with Pre => Prefix'Length <= Integer'Last - 1
      is

623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
         Inner        : Node_Id;
         Is_Terminal  : Boolean := True;
         CI           : constant Node_Id := Corresponding_Instance (Func);
         Name         : constant String := AIN_Case (Func);
         Next_Prefix  : constant String := Prefix &
                           (if Prefix'Length > 0 then "." else "") & Name;
         Terminal_Fn  : Taste_Terminal_Function;
      begin
         case Get_Category_Of_Component (CI) is
            when CC_System =>
               if Present (AIN.Subcomponents (CI)) then
                  Inner := AIN.First_Node (AIN.Subcomponents (CI));
                  while Present (Inner) loop
                     Is_Terminal := Rec_Function (Prefix  => Next_Prefix,
                                                  Context => Name,
                                                  Func    => Inner);
                     Inner := AIN.Next_Node (Inner);
                  end loop;

                  --  Inner components may not be functions but properties
                  if not Is_Terminal
                  then
                     Routes_Map.Insert (Key      => Name,
                                        New_Item =>
                                                Parse_System_Connections (CI));
                  end if;
               end if;

               if No (AIN.Subcomponents (CI)) or Is_Terminal
               then
Maxime Perrotin's avatar
Maxime Perrotin committed
653
654
655
656
657
658
659
                  Terminal_Fn := Parse_Function (Prefix => Prefix,
                                                 Name   => Name,
                                                 Inst   => CI);
                  Terminal_Fn.Context := US (Context);
                  Functions.Insert (Key       => Name,
                                    New_Item  => Terminal_Fn);
                  Is_Terminal := False;
660
661
662
663
664
665
666
667
               end if;
            when others =>
               null;
         end case;

         return Is_Terminal;
      end Rec_Function;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
      if No (Interface_Root) then
         raise Interface_Error with "Interface View parsing error";
      end if;

      Success := Ocarina.Analyzer.Analyze (AADL_Language, Interface_Root);

      if not Success then
         raise Interface_Error with "Could not analyse Interface View";
      end if;

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

      System := Root_System (Instantiate_Model (Root => Interface_Root));

Maxime Perrotin's avatar
Maxime Perrotin committed
683
      if No (System) then
Maxime Perrotin's avatar
Maxime Perrotin committed
684
         raise Interface_Error with "Could not instantiate Interface View";
Maxime Perrotin's avatar
Maxime Perrotin committed
685
      end if;
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711

      Current_Function := AIN.First_Node (AIN.Subcomponents (System));
      --  Parse functions recursively
      while Present (Current_Function) loop
         declare
            dummy : constant Boolean := Rec_Function
              (Func => Current_Function);
         begin
            Current_Function := AIN.Next_Node (Current_Function);
         end;
      end loop;

      Routes_Map.Insert (Key      => "_Root",
                         New_Item => Parse_System_Connections (System));

      --  Resolve the PI-RI connections within the functions
      for Each of Functions loop
         for RI of Each.Required loop
            declare
               --  From a RI, follow the connection until the remote PI
               Remote : constant Remote_Entity := Rec_Jump
                                                     (To_String (Each.Name),
                                                      To_String (RI.Name));
            begin
               if Remote.Function_Name /= "Not found!" then
                  RI.Remote_Interfaces.Append (Remote);
Maxime Perrotin's avatar
Maxime Perrotin committed
712
713
714
715
716
                  --  Update RCM of the RI to match the one of the remote PI
                  --  (by default it is set to Any)
                  RI.RCM :=
                    Functions (To_String (Remote.Function_Name)).Provided
                      (To_String (Remote.Interface_Name)).RCM;
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
               end if;
            end;
         end loop;
      end loop;
      --  Do the same for the PIs - they could not be updated at the same time
      --  because when we iterate on the functions, we can modify only the
      --  current function - we cannot touch the one with the remote PI.
      for Each of Functions loop
         for PI of Each.Provided loop
            for Fn of Functions loop
               for RI of Fn.Required loop
                  for Remote of RI.Remote_Interfaces loop
                     if Remote.Function_Name = Each.Name and then
                       Remote.Interface_Name = PI.Name
                     then
                        PI.Remote_Interfaces.Append
                                (Remote_Entity'(Function_Name  => Fn.Name,
                                                Interface_Name => RI.Name));
                     end if;
                  end loop;
               end loop;
            end loop;
         end loop;
      end loop;

      return IV_AST : constant Complete_Interface_View :=
                                                 (Flat_Functions => Functions);
Maxime Perrotin's avatar
Maxime Perrotin committed
744
   end Parse_Interface_View;
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789

   procedure Rename_Function (IV       : in out Complete_Interface_View;
                              From, To : String)
   is
      FV        : Taste_Terminal_Function :=
                                       IV.Flat_Functions.Element (Key => From);
      Remote_FV : Taste_Terminal_Function;
      Remote_If : Taste_Interface;
   begin
      FV.Name := US (To);
      for Each of FV.Provided loop
         Each.Parent_Function := FV.Name;
         --  Update the "Remote Function Name" of all connected interfaces
         for Remote of Each.Remote_Interfaces loop
            Remote_FV := IV.Flat_Functions.Element
                                     (Key => To_String (Remote.Function_Name));
            Remote_If := Remote_FV.Required.Element
                                    (Key => To_String (Remote.Interface_Name));
            for Entity of Remote_If.Remote_Interfaces loop
               if Entity.Function_Name = US (From) then
                  Entity.Function_Name := FV.Name;
               end if;
            end loop;
         end loop;
      end loop;
      for Each of FV.Required loop
         Each.Parent_Function := FV.Name;
         --  Update the "Remote Function Name" of all connected interfaces
         for Remote of Each.Remote_Interfaces loop
            Remote_FV := IV.Flat_Functions.Element
                                     (Key => To_String (Remote.Function_Name));
            Remote_If := Remote_FV.Provided.Element
                                    (Key => To_String (Remote.Interface_Name));
            for Entity of Remote_If.Remote_Interfaces loop
               if Entity.Function_Name = US (From) then
                  Entity.Function_Name := FV.Name;
               end if;
            end loop;
         end loop;
      end loop;
      IV.Flat_Functions.Delete (Key => From);
      IV.Flat_Functions.Insert (Key      => To,
                                New_Item => FV);
   end Rename_Function;

790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
   procedure Rename_Provided_Interface (IV    : in out Complete_Interface_View;
                                        Func  : String;
                                        Iface : String;
                                        To    : String) is
      FV        : Taste_Terminal_Function :=
                    IV.Flat_Functions.Element (Key => Func);
      FV_If     : Taste_Interface :=
                    FV.Provided.Element (Key => Iface);
   begin
      FV_If.Name := US (To);
      FV.Provided.Delete (Key       => Iface);
      FV.Provided.Insert  (Key      => To,
                           New_Item => FV_If);
      --  Now fix all references to this interface
      for Each of IV.Flat_Functions loop
         for RI of Each.Required loop
            for Remote of RI.Remote_Interfaces loop
               if Remote.Function_Name = FV.Name and then
                 Remote.Interface_Name = US (Iface)
               then
                  Remote.Interface_Name := FV_If.Name;
               end if;
            end loop;
         end loop;
      end loop;
   end Rename_Provided_Interface;

   procedure Rename_Required_Interface (IV    : in out Complete_Interface_View;
                                        Func  : String;
                                        Iface : String;
                                        To    : String) is
      FV        : Taste_Terminal_Function :=
                    IV.Flat_Functions.Element (Key => Func);
      FV_If     : Taste_Interface :=
                    FV.Provided.Element (Key => Iface);
   begin
      FV_If.Name := US (To);
      FV.Required.Delete (Key       => Iface);
      FV.Required.Insert  (Key      => To,
                           New_Item => FV_If);
      --  Now fix all references to this interface
      for Each of IV.Flat_Functions loop
         for PI of Each.Provided loop
            for Remote of PI.Remote_Interfaces loop
               if Remote.Function_Name = FV.Name and then
                 Remote.Interface_Name = US (Iface)
               then
                  Remote.Interface_Name := FV_If.Name;
               end if;
            end loop;
         end loop;
      end loop;
   end Rename_Required_Interface;

844
   procedure Debug_Dump (IV : Complete_Interface_View; Output : File_Type) is
845
846
847
      procedure Dump_Interface (I         : Taste_Interface;
                                Last_Leaf : Boolean := False;
                                Last_IF    : Boolean := False)
848
      is
849
850
851
         Ind : constant String := (if not Last_Leaf then "│  " else "   ");
         Bar : constant String := (if not Last_IF then "│  " else "   ");
         Pre : constant String := Ind & Bar;
852
      begin
853
854
         Put_Line (Output, Ind & (if Last_IF then "└─" else "├─")
                               & " Name : "
855
                   & To_String (I.Name) & " - in FV: "
856
                   & To_String (I.Parent_Function));
857
858
         Put_Line (Output, Pre & "├─ RCM Kind    : " & I.RCM'Img);
         Put_Line (Output, Pre & "├─ Period/MIAT : "
859
                               & I.Period_Or_MIAT'Img);
860
         Put_Line (Output, Pre & "├─ WCET (ms)   : "
861
                   & Value_Or (I.WCET_ms, 0)'Img);
862
         Put_Line (Output, Pre & "├─ Queue Size  : "
863
                   & Value_Or (I.Queue_Size, 1)'Img);
864
         Put_Line (Output, Pre & "├─ Parameters  :");
865
         for Each of I.Params loop
866
            Put_Line (Output, Pre & "│  ├─ Name            : "
867
                      & To_String (Each.Name));
868
            Put_Line (Output, Pre & "│  │  ├─ Type         : "
869
                      & To_String (Each.Sort));
870
            Put_Line (Output, Pre & "│  │  ├─ ASN.1 Module : "
871
                      & To_String (Each.ASN1_Module));
872
            Put_Line (Output, Pre & "│  │  ├─ ASN.1 File   : "
873
                      & To_String (Each.ASN1_File_Name));
874
            Put_Line (Output, Pre & "│  │  ├─ Basic type   : "
875
                      & Each.ASN1_Basic_Type'Img);
876
            Put_Line (Output, Pre & "│  │  ├─ Encoding     : "
877
                      & Each.Encoding'Img);
878
            Put_Line (Output, Pre & "│  │  └─ Direction    : "
879
                      & Each.Direction'Img);
880
         end loop;
881
         Put_Line (Output, Pre & "└─ Connections :");
882
         for Each of I.Remote_Interfaces loop
883
884
885
886
            Put_Line (Output, Pre & "   "
                      & (if I.Remote_Interfaces.Last_Element = Each
                         then "└─" else "├─")
                      & " Function "
887
                      & To_String (Each.Function_Name)
888
889
890
891
892
                      & ", interface " & To_String (Each.Interface_Name));
         end loop;
      end Dump_Interface;
   begin
      for Each of IV.Flat_Functions loop
893
         Put_Line (Output, "Function " & To_String (Each.Name)
894
895
                   & " in context " & To_String (Each.Context));

896
         Put_Line (Output, "├─ Full Prefix : "
897
                   & To_String (Value_Or (Each.Full_Prefix, US ("(none)"))));
898
899
         Put_Line (Output, "├─ Language    : "
                   & To_String (Each.Language));
900
         Put_Line (Output, "├─ Zip file    : "
901
                   & To_String (Value_Or (Each.Zip_File, US ("(none)"))));
902
903
         Put_Line (Output, "├─ Is type     : " & Each.Is_Type'Img);
         Put_Line (Output, "├─ Instance of : "
904
                   & To_String (Value_Or (Each.Instance_Of, US ("(n/a)"))));
905
         Put_Line (Output, "├─ Context Parameters :");
906
         for CP of Each.Context_Params loop
907
908
909
910
911
912
913
            Put_Line (Output, "│  "
                      & (if Each.Context_Params.Last_Element /= CP
                         then "├─ " else "└─ ")
                      & To_String (CP.Name) & " : "
                      & To_String (CP.Sort) & "- default : "
                      & To_String (CP.Default_Value) & " - asn1 module : "
                      & To_String (CP.ASN1_Module) & " - file : "
914
915
916
                      & To_String (Value_Or (CP.ASN1_File_Name,
                                             US ("(none)"))));
         end loop;
917
         Put_Line (Output, "├─ Directives:");
918
         for CP of Each.Directives loop
919
920
921
922
            Put_Line (Output, "│  "
                      & (if Each.Directives.Last_Element /= CP
                         then "├─ " else "└─ ")
                      & To_String (CP.Name) & " = "
923
924
                      & To_String (CP.Default_Value));
         end loop;
925
         Put_Line (Output, "├─ Simulink Tuneable Parameters:");
926
         for CP of Each.Simulink loop
927
928
929
930
            Put_Line (Output, "│  "
                      & (if Each.Simulink.Last_Element /= CP
                         then "├─ " else "└─ ")
                      & To_String (CP.Name) & " = "
931
932
933
                      & To_String (CP.Default_Value));
         end loop;

934
         Put_Line (Output, "├─ User properties:");
935
         for Ppty of Each.User_Properties loop
936
937
938
939
            Put_Line (Output, "│  "
                      & (if Ppty /= Each.User_Properties.Last_Element
                         then "├─ " else "└─ ")
                      & To_String (Ppty.Name) & " = "
940
941
                      & To_String (Ppty.Value));
         end loop;
942
         Put_Line (Output, "├─ Timers:");
943
         for Timer of Each.Timers loop
944
945
946
947
            Put_Line (Output, "│  "
               & (if Each.Timers.Last_Element /= Timer
                  then "├─ " else "└─ ")
               & Timer);
948
         end loop;
949
         Put_Line (Output, "├─ Provided interfaces:");
950
         for PI of Each.Provided loop
951
952
953
            Dump_Interface (I         => PI,
                            Last_Leaf => False,
                            Last_IF   => Each.Provided.Last_Element = PI);
954
         end loop;
955
         Put_Line (Output, "└─ Required interfaces:");
956
         for RI of Each.Required loop
957
958
959
            Dump_Interface (I         => RI,
                            Last_Leaf => True,
                            Last_IF   => Each.Required.Last_Element = RI);
960
         end loop;
961
         New_Line (Output);
962
      end loop;
963
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988

   --  Create a Templates_Parser translate set for an interface (PI or RI)
   function To_Template (TI : Taste_Interface) return Translate_Set is
      Result           : Translate_Set;
      Param_Names      : Vector_Tag;
      Param_Types      : Vector_Tag;
      Param_Directions : Vector_Tag;
      Param_Encodings  : Vector_Tag;
   begin
      Result :=  +Assoc  ("Name",            TI.Name)
                 & Assoc ("Kind",            TI.RCM'Img)
                 & Assoc ("Parent_Function", TI.Parent_Function);
      for Each of TI.Params loop
         Param_Names      := Param_Names & Each.Name;
         Param_Types      := Param_Types & Each.Sort;
         Param_Directions := Param_Directions & Each.Direction'Img;
         Param_Encodings  := Param_Encodings & Each.Encoding'Img;
      end loop;
      Result := Result & Assoc ("Param_Names",      Param_Names)
                       & Assoc ("Param_Types",      Param_Types)
                       & Assoc ("Param_Encodings",  Param_Encodings)
                       & Assoc ("Param_Directions", Param_Directions);
      return Result;
   end To_Template;

989
end TASTE.Interface_View;