taste-interface_view.adb 39.8 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
619
620
621
622
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
         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";
                             Func   : Node_Id) return Boolean is
         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
650
651
652
653
654
655
656
                  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;
657
658
659
660
661
662
663
664
               end if;
            when others =>
               null;
         end case;

         return Is_Terminal;
      end Rec_Function;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
      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
680
      if No (System) then
Maxime Perrotin's avatar
Maxime Perrotin committed
681
         raise Interface_Error with "Could not instantiate Interface View";
Maxime Perrotin's avatar
Maxime Perrotin committed
682
      end if;
683
684
685
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
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735

      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);
               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
736
   end Parse_Interface_View;
737
738
739
740
741
742
743
744
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

   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;

782
783
784
785
786
787
788
789
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
   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;

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

888
         Put_Line (Output, "├─ Full Prefix : "
889
                   & To_String (Value_Or (Each.Full_Prefix, US ("(none)"))));
890
891
         Put_Line (Output, "├─ Language    : "
                   & To_String (Each.Language));
892
         Put_Line (Output, "├─ Zip file    : "
893
                   & To_String (Value_Or (Each.Zip_File, US ("(none)"))));
894
895
         Put_Line (Output, "├─ Is type     : " & Each.Is_Type'Img);
         Put_Line (Output, "├─ Instance of : "
896
                   & To_String (Value_Or (Each.Instance_Of, US ("(n/a)"))));
897
         Put_Line (Output, "├─ Context Parameters :");
898
         for CP of Each.Context_Params loop
899
900
901
902
903
904
905
            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 : "
906
907
908
                      & To_String (Value_Or (CP.ASN1_File_Name,
                                             US ("(none)"))));
         end loop;
909
         Put_Line (Output, "├─ Directives:");
910
         for CP of Each.Directives loop
911
912
913
914
            Put_Line (Output, "│  "
                      & (if Each.Directives.Last_Element /= CP
                         then "├─ " else "└─ ")
                      & To_String (CP.Name) & " = "
915
916
                      & To_String (CP.Default_Value));
         end loop;
917
         Put_Line (Output, "├─ Simulink Tuneable Parameters:");
918
         for CP of Each.Simulink loop
919
920
921
922
            Put_Line (Output, "│  "
                      & (if Each.Simulink.Last_Element /= CP
                         then "├─ " else "└─ ")
                      & To_String (CP.Name) & " = "
923
924
925
                      & To_String (CP.Default_Value));
         end loop;

926
         Put_Line (Output, "├─ User properties:");
927
         for Ppty of Each.User_Properties loop
928
929
930
931
            Put_Line (Output, "│  "
                      & (if Ppty /= Each.User_Properties.Last_Element
                         then "├─ " else "└─ ")
                      & To_String (Ppty.Name) & " = "
932
933
                      & To_String (Ppty.Value));
         end loop;
934
         Put_Line (Output, "├─ Timers:");
935
         for Timer of Each.Timers loop
936
937
938
939
            Put_Line (Output, "│  "
               & (if Each.Timers.Last_Element /= Timer
                  then "├─ " else "└─ ")
               & Timer);
940
         end loop;
941
         Put_Line (Output, "├─ Provided interfaces:");
942
         for PI of Each.Provided loop
943
944
945
            Dump_Interface (I         => PI,
                            Last_Leaf => False,
                            Last_IF   => Each.Provided.Last_Element = PI);
946
         end loop;
947
         Put_Line (Output, "└─ Required interfaces:");
948
         for RI of Each.Required loop
949
950
951
            Dump_Interface (I         => RI,
                            Last_Leaf => True,
                            Last_IF   => Each.Required.Last_Element = RI);
952
         end loop;
953
         New_Line (Output);
954
      end loop;
955
   end Debug_Dump;
956
end TASTE.Interface_View;