taste-aadl_parser.adb 56.4 KB
Newer Older
1
2
3
4
--  ******************************* KAZOO  *******************************  --
--  (c) 2017-2021 European Space Agency - maxime.perrotin@esa.int
--  See LICENSE file
--  *********************************************************************** --
5
with System.Assertions,
6
     Ada.Exceptions,
7
     Ada.IO_Exceptions,
8
     Ada.Text_IO,
9
     Ada.Directories,
10
     Ada.Strings.Equal_Case_Insensitive,
11
     Ada.Containers,
12
     Ada.Environment_Variables,
13
     Ada.Characters.Handling,   -- Contains "To_Lower"
14
     GNAT.Command_Line,
15
16
     Errors,
     Locations,
17
     Ocarina.AADL_Values,
18
19
20
     Ocarina.Namet,
     Ocarina.Configuration,
     Ocarina.Files,
21
     Ocarina.Parser,
22
     Ocarina.Options,
Maxime Perrotin's avatar
Maxime Perrotin committed
23
     TASTE.Backend,
Maxime Perrotin's avatar
Maxime Perrotin committed
24
     TASTE.Backend.Code_Generators,
25
     TASTE.Semantic_Check;
26
27
28

use Ada.Text_IO,
    Ada.Exceptions,
29
    Ada.Directories,
30
    Ada.Containers,
31
    Ada.Characters.Handling,
32
33
34
35
    Locations,
    Ocarina.Namet,
    Ocarina;

36
37
38
39
40
41
--  for the parsing of ConcurrencyView_Properties.aadl:
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Nutils;
use Ocarina.ME_AADL.AADL_Tree.Nodes;
use Ocarina.ME_AADL.AADL_Tree.Nutils;

42
43
package body TASTE.AADL_Parser is

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
   package Env renames Ada.Environment_Variables;

   procedure Find_Shared_Libraries (Model : out TASTE_Model) is
      --  Look for shared component types and update the list of AADL files
      --  to be parsed together with interface and deployment views

      Shared_Types   : constant String :=
        Env.Value (Name    => "TASTE_SHARED_TYPES",
                   Default => "/home/taste/tool-inst/share/SharedTypes");

      --  To iterate on folders:
      ST      : Search_Type;
      Current : Directory_Entry_Type;
   begin
      Model.Configuration.Shared_Lib_Dir := US (Shared_Types);
      Start_Search (Search    => ST,
                    Pattern   => "",
                    Directory => Shared_Types,
                    Filter    => (Directory => True, others => False));
      if not More_Entries (ST) then
         Put_Info ("No shared components found");
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
66

67
68
      while More_Entries (ST) loop
         Get_Next_Entry (ST, Current);
Maxime Perrotin's avatar
Maxime Perrotin committed
69
         if Base_Name (Full_Name (Current)) /= "" then
70
71
            --  Ignore "." and ".." folders

Maxime Perrotin's avatar
Maxime Perrotin committed
72
73
            --  Add folder to Ocarina include path (equivalent to -I)
            Ocarina.Options.Add_Library_Path (Full_Name (Current) & "/");
74

Maxime Perrotin's avatar
Maxime Perrotin committed
75
76
77
            --  The model keeps a list of shared types for the backends
            Model.Configuration.Shared_Types.Append
              (Base_Name (Full_Name (Current)));
78

Maxime Perrotin's avatar
Maxime Perrotin committed
79
80
            Put_Info ("Added " & Full_Name (Current) & " to Include path");
         end if;
81
82
83
      end loop;
   exception
      when Ada.IO_Exceptions.Name_Error =>
84
         Put_Error ("Shared library folder not found: " & Shared_Types);
85
86
   end Find_Shared_Libraries;

87
88
89
90
   procedure Parse_Set_Of_AADL_Files (Dest : in out Node_Id) is
      F              : Types.Int := Ocarina.Files.Sources.First;
      File_Name      : Name_Id;
      File_Descr     : Location;
Maxime Perrotin's avatar
Maxime Perrotin committed
91
      Current        : Unbounded_String;
92
93
   begin
      loop
Maxime Perrotin's avatar
Maxime Perrotin committed
94
         Current :=  US (Get_Name_String (Ocarina.Files.Sources.Table (F)));
95
96
97
         File_Name := Ocarina.Files.Search_File
           (Ocarina.Files.Sources.Table (F));
         if File_Name = No_Name then
98
99
            null;
            --  Put_Info ("File not found: " & To_String (Current));
Maxime Perrotin's avatar
Maxime Perrotin committed
100
101
102
103
104
         elsif Current /= "gruart.aadl" and Current /= "grspw.aadl"
           and Current /= "native_uart.aadl" and Current /= "generic_bus.aadl"
           and Current /= "gr_cpci_x4cv.aadl"
           and Current /= "processor_properties.aadl"
         then
105
            --  Put_Info ("Loading dependency: " & To_String (Current));
106
107
            File_Descr := Ocarina.Files.Load_File (File_Name);
            Dest := Ocarina.Parser.Parse (AADL_Language, Dest, File_Descr);
Maxime Perrotin's avatar
Maxime Perrotin committed
108
         else
109
            Put_Debug ("Ignoring duplicate: " & To_String (Current));
110
111
112
113
114
115
         end if;
         exit when F = Ocarina.Files.Sources.Last;
         F := F + 1;
      end loop;
   end Parse_Set_Of_AADL_Files;

Maxime Perrotin's avatar
Maxime Perrotin committed
116
117
118
   procedure Build_TASTE_AST (Model : out TASTE_Model) is
      use String_Holders,
          String_Vectors;
119
120
121
122
   begin
      Banner;
      --  Parse arguments before initializing Ocarina, otherwise Ocarina eats
      --  some arguments (all file parameters).
123
      Parse_Command_Line (Model.Configuration);
124
      Initialize_Ocarina;
Maxime Perrotin's avatar
Maxime Perrotin committed
125
126
      --  Enable the "-y" flag from Ocarina to load and parse automatically the
      --  dependencies (WITH ...) of the AADL model.
Jerome Hugues's avatar
Jerome Hugues committed
127
128
      Ocarina.Options.Auto_Load_AADL_Files := True;
      Ocarina.Options.Verbose := True;
129
130
131

      AADL_Language := Get_String_Name ("aadl");

132
133
      Find_Shared_Libraries (Model);

134
135
136
      --  -------------------------
      --  Parse the interface view
      --  -------------------------
137

Maxime Perrotin's avatar
Maxime Perrotin committed
138
139
140
141
142
      --  Define the list of AADL files to parse
      Interface_AADL_Lib := Interface_AADL_Lib
        & Model.Configuration.Interface_View.Element
        & Model.Configuration.Data_View.Element
        & Model.Configuration.Other_Files;
143

Maxime Perrotin's avatar
Maxime Perrotin committed
144
      --  Prepare Ocarina (it will determine other file dependencies, if any)
145
146
147
      for Each of Interface_AADL_Lib loop
         Ocarina.Files.Add_File_To_Parse_List (Get_String_Name (Each), False);
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
148

Maxime Perrotin's avatar
Maxime Perrotin committed
149
150
151
152
153
154
155
156
157
158
159
160
161
      --  If requested, call Ocarina to parse the AADL file and build the AST
      if not Model.Configuration.Check_Data_View then
         Parse_Set_Of_AADL_Files (Dest => Interface_Root);
         if Interface_Root = No_Node then
            raise AADL_Parser_Error with "Interface view parsing error";
         else
            Model.Interface_View := Parse_Interface_View (Interface_Root);
         end if;
      end if;

      --  ------------------
      --  Parse the dataview
      --  ------------------
Maxime Perrotin's avatar
Maxime Perrotin committed
162

Maxime Perrotin's avatar
Maxime Perrotin committed
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
      --  Reset Ocarina's list of AADL files:
      Ocarina.Files.Sources.Free;
      Ocarina.Files.Sources.Init;

      --  Add DataView.aadl to the list of files to parse
      Data_View_AADL_Lib := Data_View_AADL_Lib
        & Model.Configuration.Data_View.Element;

      --  Prepare Ocarina (it will determine other file dependencies, if any)
      for Each of Data_View_AADL_Lib loop
            Ocarina.Files.Add_File_To_Parse_List
              (Get_String_Name (Each), False);
      end loop;

      --  Call Ocarina to parse the AADL files
      Parse_Set_Of_AADL_Files (Dest => Dataview_Root);

      --  Create the AST of the data view and check ASN.1 file presence
      Model.Data_View := Parse_Data_View (Dataview_root);
      Model.Data_View.Check_Files;

      --  User only wants to check ASN.1 file presence, skip IV/DV parsing
      if Model.Configuration.Check_Data_View then
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
187
      end if;
188

189
      --  ---------------------------------------------------------
190
      --  Parse the deployment view if found
191
192
      --  ---------------------------------------------------------

193
      if not Model.Configuration.Deployment_View.Is_Empty then
194

195
196
         --  Reset Ocarina's list of AADL files:
         Ocarina.Files.Sources.Free;
197
         Ocarina.Files.Sources.Init;
198

Maxime Perrotin's avatar
Maxime Perrotin committed
199
200
201
202
203
204
         --  Define the list of AADL files to parse
         Deployment_AADL_Lib := Deployment_AADL_Lib
           & Model.Configuration.Deployment_View.Element
           & Model.Configuration.Interface_View.Element
           & Model.Configuration.Data_View.Element
           & Model.Configuration.Other_Files;
205

206
207
208
         --  Unless otherwise specified, add ocarina_components.aadl:
         if not Model.Configuration.No_Stdlib then
            Deployment_AADL_Lib.Append ("ocarina_components.aadl");
209
         end if;
210

211
212
213
214
215
         --  Prepare Ocarina by setting the list of files:
         for Each of Deployment_AADL_Lib loop
            Ocarina.Files.Add_File_To_Parse_List
              (Get_String_Name (Each), False);
         end loop;
216

217
218
         --  Call Ocarina to parse the AADL files:
         Parse_Set_Of_AADL_Files (Dest => Deployment_Root);
219

220
221
222
         if Deployment_Root = No_Node then
            raise AADL_Parser_Error with "Deployment View is incorrect";
         else
Maxime Perrotin's avatar
Maxime Perrotin committed
223
            --  Build the AST
224
225
226
227
            Model.Deployment_View :=
              Deployment_View_Holders.To_Holder
                (Parse_Deployment_View
                   (Deployment_Root, Model.Interface_View));
228
         end if;
229
      end if;
230

Maxime Perrotin's avatar
Maxime Perrotin committed
231
232
233
      --  -------------------------------------
      --  Parse ConcurrencyView_Properties.aadl
      --  -------------------------------------
234

Maxime Perrotin's avatar
Maxime Perrotin committed
235
236
237
238
239
      --  Reset Ocarina's list of AADL files:
      Ocarina.Files.Sources.Free;
      Ocarina.Files.Sources.Init;
      Ocarina.Files.Add_File_To_Parse_List
        (Get_String_Name ("ConcurrencyView_Properties.aadl"), False);
Maxime Perrotin's avatar
Maxime Perrotin committed
240

Maxime Perrotin's avatar
Maxime Perrotin committed
241
242
      --  Call Ocarina to parse the AADL files:
      Parse_Set_Of_AADL_Files (Dest => Concurrency_Properties_Root);
243

Maxime Perrotin's avatar
Maxime Perrotin committed
244
245
246
247
248
--        if Concurrency_Properties_Root = No_Node then
--           raise AADL_Parser_Error with
--             "Error parsing ConcurrencyView_Properties.aadl";
--        end if;
   end Build_TASTE_AST;
249
250
251
252

   function Parse_Project return TASTE_Model is
      Result : TASTE_Model;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
253
      Build_TASTE_AST (Model => Result);
254
      Ocarina.Configuration.Reset_Modules;
255
      Semantic_Check.Check_Model (Result);
256
257
      return Result;
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
258
259
      when Error : System.Assertions.Assert_Failure =>
         Put_Error ("Parsing error: " & Exception_Message (Error));
Maxime Perrotin's avatar
Maxime Perrotin committed
260
         Errors.Display_Bug_Box (Error);
Maxime Perrotin's avatar
Maxime Perrotin committed
261
         raise Quit_Taste;
262
263
264
265
266
      when Error : AADL_Parser_Error
         | Interface_Error
         | Function_Error
         | No_RCM_Error
         | Deployment_View_Error
267
         | Data_View_Error
268
         | Semantic_Check.Semantic_Error
269
         | Device_Driver_Error =>
270
         Put_Error (Exception_Message (Error));
271
272
273
         raise Quit_Taste;
      when GNAT.Command_Line.Exit_From_Command_Line =>
         New_Line;
274
275
         Put_Info ("For more information, visit " & Underline & White_Bold
                   & "https://taste.tools");
276
277
278
279
         raise Quit_Taste;
      when GNAT.Command_Line.Invalid_Switch
         | GNAT.Command_Line.Invalid_Parameter
         | GNAT.Command_Line.Invalid_Section =>
280
         Put_Error ("Invalid switch or parameter (try --help)" & No_Color);
281
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
282
283
      when Quit_Taste =>
         raise;
284
285
286
287
288
      when E : others =>
         Errors.Display_Bug_Box (E);
         raise Quit_Taste;
   end Parse_Project;

289
290
291
292
   function Find_Binding (Model : TASTE_Model;
                          F     : Unbounded_String)
                          return Option_Partition.Option is
      use Option_Partition;
293
294
      function Is_Equal (Left, Right : String) return Boolean
         renames Ada.Strings.Equal_Case_Insensitive;
295
296
      Function_Name : constant String := To_String (F);
   begin
297
298
299
      if Model.Deployment_View.Is_Empty then
         raise Deployment_View_Error with "Missing Deployment View";
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
300
      for Node of Model.Deployment_View.Element.Nodes loop
301
302
         for Each of Node.Partitions loop
            for Binding of Each.Bound_Functions loop
303
               if Is_Equal (Binding, Function_Name) then
304
305
306
307
308
309
310
311
                  return Just (Each);
               end if;
            end loop;
         end loop;
      end loop;
      return Nothing;
   end Find_Binding;

Maxime Perrotin's avatar
Maxime Perrotin committed
312
   procedure Set_Calling_Threads (Partition : in out CV_Partition) is
Maxime Perrotin's avatar
Maxime Perrotin committed
313
      procedure Rec_Add_Calling_Thread (Thread_Id : String;
Maxime Perrotin's avatar
Maxime Perrotin committed
314
                                        Block_Id  : String) is
Maxime Perrotin's avatar
Maxime Perrotin committed
315
316
      begin
         --  First add thread to its corresponding protected function
Maxime Perrotin's avatar
Maxime Perrotin committed
317
318
         --  Stop recursion if thread is already there...
         if not String_Sets.To_Set (Thread_Id).Is_Subset
Maxime Perrotin's avatar
Maxime Perrotin committed
319
           (Of_Set => Partition.Blocks (Block_Id).Calling_Threads)
Maxime Perrotin's avatar
Maxime Perrotin committed
320
         then
Maxime Perrotin's avatar
Maxime Perrotin committed
321
            Partition.Blocks (Block_Id).Calling_Threads.Insert (Thread_Id);
Maxime Perrotin's avatar
Maxime Perrotin committed
322
323
324
325
         else
            return;
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
326
         --  Then recurse on its (Un)protected RIs.
327
         for RI of Partition.Blocks (Block_Id).Ref_Function.Required loop
Maxime Perrotin's avatar
Maxime Perrotin committed
328
329
            if RI.RCM = Protected_Operation or RI.RCM = Unprotected_Operation
            then
330
               --  Put_Line ("RI: " & To_String (RI.Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
331
               for Remote of RI.Remote_Interfaces loop
332
333
334
335
336
337
338
339
340
341
                  if Remote.Function_Name /=
                      Partition.Deployment_Partition.Name & "_Timer_Manager"
                  then
                     --  Put_Line (To_String (Remote.Function_Name)
                     --          & " :: " & To_String (Remote.Language));
                     --  Timer manager calling thread is only the Tick function
                     Rec_Add_Calling_Thread
                       (Thread_Id => Thread_Id,
                        Block_Id  => To_String (Remote.Function_Name));
                  end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
342
343
344
345
346
               end loop;
            end if;
         end loop;
      end Rec_Add_Calling_Thread;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
347
      for Each of Partition.Threads loop
348
349
         --  Put_Line ("Thread: " & To_String (Each.Name) & " - Block: "
         --        & To_String (Each.Protected_Block_Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
350
351
         Rec_Add_Calling_Thread (Thread_Id => To_String (Each.Name),
                                 Block_Id  => To_String
Maxime Perrotin's avatar
Maxime Perrotin committed
352
                                   (Each.Protected_Block_Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
353
354
355
      end loop;
   end Set_Calling_Threads;

356
   --  Find the output ports of a thread by following the connections
357
358
359
   function Get_Output_Ports (Model          : TASTE_Model;
                              F              : Taste_Terminal_Function;
                              Partition_Name : String) return Ports.Map
360
   is
361
      Result            : Ports.Map;
362
      Visited_Functions : String_Sets.Set;
363

364
365
366
      procedure Rec_Find_Thread (Ports_Map : in out Ports.Map;
                                 Visited   : in out String_Sets.Set;
                                 Func      : Taste_Terminal_Function) is
367
368
369
370
371
372
373
374
375
376
377
         use String_Sets;
         Current_Function : constant String_Sets.Set :=
           String_Sets.To_Set (To_String (Func.Name));
      begin
         --  Recursively find distand threads by following (un)pro RI paths
         --  Ignore already visited nodes (system may have circular paths)
         if Current_Function.Is_Subset (Of_Set => Visited) then
            return;
         else
            Visited := Visited or Current_Function;
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
378
379
380
381
         if Func.Is_Type then
            --  Ignore function types, only work with instances
            return;
         end if;
382
383

         for RI of Func.Required loop
Maxime Perrotin's avatar
Maxime Perrotin committed
384
385
386
387
            if RI.Remote_Interfaces.Is_Empty then
               goto Continue;
            end if;

388
389
            if RI.RCM = Unprotected_Operation or RI.RCM = Protected_Operation
            then
390
391
392
393
394
395
396
               for Remote of RI.Remote_Interfaces loop
                  if Remote.Function_Name /= Partition_Name & "_Timer_Manager"
                  then
                     Rec_Find_Thread (Ports_Map => Ports_Map,
                                      Visited   => Visited,
                                      Func      =>
                                      Model.Interface_View.Flat_Functions
397
398
                                  (To_String
                          (RI.Remote_Interfaces.First_Element.Function_Name)));
399
400
                  end if;
               end loop;
401
402
403
404
            else
               declare
                  --  Assume only one remote connection per RI
                  --  Have to iterate on Remote_Interfaces if that changes
405
406

                  Dist      : constant Remote_Entity :=
407
                    RI.Remote_Interfaces.First_Element;
408
                  Remote_Thread_Name : constant Unbounded_String :=
409
410
                    To_Lower (To_String (Dist.Function_Name))
                    & "_" & Dist.Interface_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
411
412
413
414
415
416
417
                  --  The port name cannot be RI.Name because that could
                  --  cause multiple ports with the same name if more than
                  --  one function connected through a chain of sync calls
                  --  have a RI of that name.
                  --  Port_Name : constant Unbounded_String := RI.Name;
                  Port_Name : constant Unbounded_String :=
                      Dist.Function_Name & "_" & RI.Name;
418
                  New_P     : constant Thread_Port :=
419
420
                    (Name          => Port_Name,
                     Remote_Thread => Remote_Thread_Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
421
422
                     Remote_PI     => Dist.Interface_Name,
                     RI            => RI);
423
               begin
424
425
                  Ports_Map.Include (Key      => To_String (Port_Name),
                                     New_Item => New_P);
426
427
               end;
            end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
428
            <<Continue>>
429
430
431
         end loop;
      end Rec_Find_Thread;
   begin
432
433
434
      Rec_Find_Thread (Ports_Map => Result,
                       Visited   => Visited_Functions,
                       Func      => F);
435
436
437
      return Result;
   end Get_Output_Ports;

438
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
439
440
441
      CV : Taste_Concurrency_View :=
        (Base_Template_Path => Model.Configuration.Binary_Path,
         Base_Output_Path   => Model.Configuration.Output_Dir,
Maxime Perrotin's avatar
Maxime Perrotin committed
442
         Deployment         => Model.Deployment_View.Element,
Maxime Perrotin's avatar
Maxime Perrotin committed
443
         Configuration      => Model.Configuration,
Maxime Perrotin's avatar
Maxime Perrotin committed
444
         others             => <>);
445
      use String_Vectors;
446
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
447
      --  Initialize the lists of nodes and partitions based on the DV
Maxime Perrotin's avatar
Maxime Perrotin committed
448
      for Node of Model.Deployment_View.Element.Nodes loop
Maxime Perrotin's avatar
Maxime Perrotin committed
449
         declare
450
451
            New_Node : CV_Node :=
              (Deployment_Node => Node, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
452
453
454
         begin
            for Partition of Node.Partitions loop
               declare
455
456
                  New_Partition : constant CV_Partition :=
                    (Deployment_Partition => Partition, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
457
458
459
460
461
462
463
464
465
466
467
               begin
                  New_Node.Partitions.Insert
                    (Key      => To_String (Partition.Name),
                     New_Item => New_Partition);
               end;
            end loop;
            CV.Nodes.Insert (Key      => To_String (Node.Name),
                             New_Item => New_Node);
         end;
      end loop;

468
469
      --  Create one thread per Cyclic and Sporadic interface
      --  Create one protected block per application code
Maxime Perrotin's avatar
Maxime Perrotin committed
470
      --  and map them on the Concurrency View nodes/partitions
471
      for F of Model.Interface_View.Flat_Functions loop
472
473
474
         if F.Is_Type then
            goto Continue;
         end if;
475
         declare
Maxime Perrotin's avatar
Maxime Perrotin committed
476
477
            Function_Name : constant String := To_String (F.Name);
            Node : constant Option_Node.Option :=
Maxime Perrotin's avatar
Maxime Perrotin committed
478
              Model.Deployment_View.Element.Find_Node (Function_Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
479
480
481
482
483
484
485
486
487
488
            Node_Name : constant String :=
              (if Node.Has_Value
               then To_String (Node.Unsafe_Just.Name)
               else "");
            Partition_Name : constant String :=
              (if Node.Has_Value
               then To_String (Node.Unsafe_Just.Find_Partition
                 (Function_Name).Unsafe_Just.Name)
               else "");

489
            Block : Protected_Block :=
490
491
492
              (Ref_Function => F,
               Node         => Node,
               others       => <>);
493
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
494
495
496
497
498
            if not Node.Has_Value then
               --  Ignore functions that are not mapped to a node/partition
               goto Continue;
            end if;

499
            for PI of F.Provided loop
500
501
502
503
504
505
506
507
508
509
               --  Ignore interfaces that are not called by anyone
               if PI.RCM /= Cyclic_Operation
                 and PI.Remote_Interfaces.Length = 0
               then
                  Put_Info ("Ignoring unconnected interface "
                            & To_String (PI.Name) & " in function "
                            & To_String (F.Name));
                  goto next_pi;
               end if;

510
511
512
513
514
               declare
                  New_PI : Protected_Block_PI := (Name   => PI.Name,
                                                  PI     => PI,
                                                  others => <>);
               begin
515
516
517
                  --  Convert cyclic/sporadic to Protected
                  New_PI.PI.RCM := (if PI.RCM = Unprotected_Operation
                                    then Unprotected_Operation
518
                                    else Protected_Operation);
Maxime Perrotin's avatar
Maxime Perrotin committed
519
                  --  Check in the DV if any caller is remote
520
521
522
                  for Remote of PI.Remote_Interfaces loop
                     declare
                        Remote_Node : constant Option_Node.Option :=
Maxime Perrotin's avatar
Maxime Perrotin committed
523
                          Model.Deployment_View.Element.Find_Node
524
525
                            (To_String (Remote.Function_Name));
                     begin
Maxime Perrotin's avatar
Maxime Perrotin committed
526
527
528
                        if not Remote_Node.Has_Value
                          or not Block.Node.Has_Value
                        then
529
                           raise Concurrency_View_Error with
Maxime Perrotin's avatar
Maxime Perrotin committed
530
                             "Concurrency Generation Error (parser bug?)";
531
                        end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
532

533
534
535
536
537
538
                        if Block.Node.Unsafe_Just /= Remote_Node.Unsafe_Just
                        then
                           --  At least one caller is on a different node
                           New_PI.Local_Caller := False;
                        end if;
                     end;
Maxime Perrotin's avatar
Maxime Perrotin committed
539
                  end loop;
540
541
                  Block.Block_Provided.Insert (Key      => To_String (PI.Name),
                                               New_Item => New_PI);
542
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
543
544
               if PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation then
                  declare
545
                     Thread : constant AADL_Thread :=
546
                       (Name                 => To_Lower (To_String (F.Name))
547
548
                        & "_" & PI.Name,
                        Partition_Name       => US (Partition_Name),
549
                        RCM                  => US (PI.RCM'Img),
Maxime Perrotin's avatar
Maxime Perrotin committed
550
                        Need_Mutex           => (F.Provided.Length > 1),
Maxime Perrotin's avatar
Maxime Perrotin committed
551
                        Entry_Port_Name      => PI.Name,
552
553
                        Ref_Protected_Block  => Block,
                        Protected_Block_Name => Block.Ref_Function.Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
554
                        Node                 => Block.Node,
555
                        PI                   => PI,
556
557
                        Output_Ports         => Get_Output_Ports
                                                    (Model, F, Partition_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
558
559
560
561
                        Priority             => US (PI.Priority'Img),
                        Dispatch_Offset_Ms   => US (PI.Dispatch_Offset'Img),
                        Stack_Size_In_Bytes  => US
                            (Integer'Image (PI.Stack_Size * 1000)));
Maxime Perrotin's avatar
Maxime Perrotin committed
562
                  begin
Maxime Perrotin's avatar
Maxime Perrotin committed
563
564
                     CV.Nodes
                       (Node_Name).Partitions (Partition_Name).Threads.Include
Maxime Perrotin's avatar
Maxime Perrotin committed
565
566
567
568
                       (Key      => To_String (Thread.Name),
                        New_Item => Thread);
                  end;
               end if;
569
               <<next_pi>>
570
571
            end loop;
            --  Add the block to the Concurrency View
Maxime Perrotin's avatar
Maxime Perrotin committed
572
            CV.Nodes (Node_Name).Partitions (Partition_Name).Blocks.Insert
573
              (Key      => To_String (Block.Ref_Function.Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
574
               New_Item => Block);
575
         end;
576
         <<Continue>>
577
      end loop;
578

Maxime Perrotin's avatar
Maxime Perrotin committed
579
580
      for Node of CV.Nodes loop
         for Partition of Node.Partitions loop
581
            --  Find and set protected blocks calling threads
Maxime Perrotin's avatar
Maxime Perrotin committed
582
            Set_Calling_Threads (Partition);
583

Maxime Perrotin's avatar
Maxime Perrotin committed
584
585
586
587
588
            --  Check that all blocks have a calling thread, otherwise
            --  they will never run
            for B of Partition.Blocks loop
               if B.Calling_Threads.Length = 0 then
                  raise Concurrency_View_Error with
589
590
591
                    "Function "
                    & To_String (B.Ref_Function.Name)
                    & " has no active caller";
Maxime Perrotin's avatar
Maxime Perrotin committed
592
593
594
               end if;
            end loop;

595
            --  Define ports at partition (process) level
596
597
            --  (ports are for all interfaces of a function not located
            --  in the same partition of the system)
598
599
600
601
602
603
604
605
606
607
608
609
610
            for T of Partition.Threads loop
               --  Check each Remote PI of the entry port of the thread
               for Remote of T.PI.Remote_Interfaces loop
                  declare
                     Node : constant Option_Node.Option  :=
                       CV.Deployment.Find_Node
                         (To_String (Remote.Function_Name));
                     Part : Option_Partition.Option;
                     --  Optional type of the parameter:
                     Sort : constant Unbounded_String :=
                       (if not T.PI.Params.Is_Empty
                        then T.PI.Params.First_Element.Sort
                        else US (""));
611
612
613
614
615
                     Encoding : constant Unbounded_String :=
                       (if not T.PI.Params.Is_Empty
                        then US
                          (T.PI.Params.First_Element.Encoding'Image)
                        else US (""));
616
617
618
619
620
621
622
623
624
                  begin
                     if Node.Has_Value then
                        Part :=
                          Node.Unsafe_Just.Find_Partition
                            (To_String (Remote.Function_Name));

                        if Part.Has_Value
                          and then Part.Unsafe_Just.Name
                            /= Partition.Deployment_Partition.Name
625
626
                             and then not Partition.In_Ports.Contains
                               (To_String (T.Entry_Port_Name))
627
628
629
630
631
632
633
634
                        then
                           --  shouldn't we check for presence first in case
                           --  there are multiple callers?
                           Partition.In_Ports.Insert
                             (Key      => To_String (T.Entry_Port_Name),
                              New_Item => (Port_Name   => T.Entry_Port_Name,
                                           Thread_Name => T.Name,
                                           Type_Name   => Sort,
635
                                           Encoding    => Encoding,
636
                                           Queue_Size  => US ("1"),
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
                                           Remote_Partition_Name
                                                    => Part.Unsafe_Just.Name));
                        end if;
                     else
                        Put_Error ("This should never happen.");
                     end if;
                  end;
               end loop;
               --  Do the same for output ports
               for Out_Port of T.Output_Ports loop
                  for Remote of Out_Port.RI.Remote_Interfaces loop
                     declare
                        Node : constant Option_Node.Option  :=
                          CV.Deployment.Find_Node
                            (To_String (Remote.Function_Name));
                        Part : Option_Partition.Option;
                        --  Optional type of the parameter:
                        Sort : constant Unbounded_String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
655
656
                          (if not Out_Port.RI.Params.Is_Empty
                           then Out_Port.RI.Params.First_Element.Sort
657
                           else US (""));
658
659
660
661
662
                        Encoding : constant Unbounded_String :=
                          (if not Out_Port.RI.Params.Is_Empty
                           then US
                             (Out_Port.RI.Params.First_Element.Encoding'Image)
                           else US (""));
663
664
665
666
667
668
669
670
                     begin
                        if Node.Has_Value then
                           Part := Node.Unsafe_Just.Find_Partition
                             (To_String (Remote.Function_Name));

                           if Part.Has_Value and then Part.Unsafe_Just.Name
                             /= Partition.Deployment_Partition.Name
                           then
671
672
673
674
675
676
677
                              if not Partition.Out_Ports.Contains
                                (To_String (Out_Port.RI.Name))
                              then
                                 --  Create a new port and reference the thread
                                 Partition.Out_Ports.Insert
                                   (Key      => To_String (Out_Port.RI.Name),
                                    New_Item => (Port_Name   =>
Maxime Perrotin's avatar
Maxime Perrotin committed
678
679
                                                     --  Out_Port.RI.Name,
                                                     Out_Port.Name,
680
681
682
683
                                                 Connected_Threads =>
                                                   String_Vectors.Empty_Vector
                                                 & To_String (T.Name),
                                                 Type_Name   => Sort,
684
                                                 Encoding => Encoding,
685
                                                 Remote_Partition_Name =>
686
                                                   Part.Unsafe_Just.Name,
687
688
                                                 Remote_Function_Name =>
                                                   Remote.Function_Name,
689
                                                 Remote_Port_Name =>
690
691
                                                   Remote.Interface_Name,
                                                 Queue_Size => US ("1")));
692
693
694
695
696
697
698
                              else
                                 --  Port already exists: just add this thread
                                 Partition.Out_Ports
                                   (To_String
                                      (Out_Port.RI.Name)).Connected_Threads
                                     .Append (To_String (T.Name));
                              end if;
699
700
701
702
703
704
705
706
                           end if;
                        else
                           Put_Error ("This should never happen.");
                        end if;
                     end;
                  end loop;
               end loop;
            end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
707
708
         end loop;
      end loop;
709

Maxime Perrotin's avatar
Maxime Perrotin committed
710
      Model.Concurrency_View := CV;
711
712
   end Add_Concurrency_View;

713
   procedure Dump (Model : TASTE_Model) is
714
715
      Output_Path : constant String :=
        Model.Configuration.Output_Dir.Element & "/Debug";
716
      Output  : File_Type;
717
   begin
718
719
720
721
722
723
724
725
726
      if Model.Configuration.Debug_Flag then
         Create_Path (Output_Path);
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/InterfaceView.dump");
         Put_Info ("Dump of the Interface View");
         Model.Interface_View.Debug_Dump (Output);
         Close (Output);

727
728
729
         if not Model.Configuration.Deployment_View.Is_Empty and
             not Model.Deployment_View.Is_Empty
         then
730
731
732
733
            Create (File => Output,
                    Mode => Out_File,
                    Name => Output_Path & "/DeploymentView.dump");
            Put_Info ("Dump of the Deployment View");
Maxime Perrotin's avatar
Maxime Perrotin committed
734
            Model.Deployment_View.Element.Debug_Dump (Output);
735
736
            Close (Output);
         end if;
737
738
739
740
741
742
743
744
745
746

         if Model.Configuration.Glue then
            Create (File => Output,
                    Mode => Out_File,
                    Name => Output_Path & "/ConcurrencyView.dump");
            Put_Info ("Dump of the Concurrency View");
            Model.Concurrency_View.Debug_Dump (Output);
            Close (Output);
         end if;

747
748
749
750
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/DataView.dump");
         Put_Info ("Dump of the Data View");
Maxime Perrotin's avatar
Maxime Perrotin committed
751
         Model.Data_View.Debug_Dump (Output);
752
         Close (Output);
753

754
755
756
757
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/commandline.dump");
         Put_Info ("Dump of the Command Line");
Maxime Perrotin's avatar
Maxime Perrotin committed
758
         Model.Configuration.Debug_Dump (Output);
759
         Close (Output);
760
761
762
763

         Put_Info ("Make a local copy of ASN.1 files for export");
         Create_Path (Output_Path & "/Export");
         Model.Data_View.Export_ASN1_Files (Output_Path & "/Export/");
764
      end if;
765
766
767
768
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
769
770
   end Dump;

Maxime Perrotin's avatar
Maxime Perrotin committed
771
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
772
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
773
      TASTE.Backend.Code_Generators.Generate (Model);
774
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
775
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
776
777
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
778
779
      when Error : others =>
         Errors.Display_Bug_Box (Error);
780
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
781
   end Generate_Code;
Maxime Perrotin's avatar
Maxime Perrotin committed
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799

   function Process_Function (F : in out Taste_Terminal_Function)
      return Function_Maps.Map
   is
      New_Functions    : Function_Maps.Map;
   begin
      --  Look for GUIs and add a Poll PI (if there is at least one RI)
      if F.Required.Length > 0 and F.Language = "gui" then
         F.Provided.Insert (Key      => "Poll",
                            New_Item => (Name            => US ("Poll"),
                                         Parent_Function => F.Name,
                                         RCM             => Cyclic_Operation,
                                         Period_Or_MIAT  => 10,
                                         others => <>));
      end if;
      return New_Functions;
   end Process_Function;

800
   procedure Preprocessing (Model : in out TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
801
      New_Functions : Function_Maps.Map;
802
803
804
      DV : Complete_Deployment_View := Model.Deployment_View.Element;
      use Remote_Entities,
          Parameters;
Maxime Perrotin's avatar
Maxime Perrotin committed
805
806
807
   begin
      --  Processing of user-defined functions (may return a list of new
      --  functions that will be added to the model)
808
      for F of Model.Interface_View.Flat_Functions loop
Maxime Perrotin's avatar
Maxime Perrotin committed
809
810
811
812
813
814
815
816
817
         declare
            Funcs : constant Function_Maps.Map := Process_Function (F);
         begin
            for Each of Funcs loop
               New_Functions.Insert (Key      => To_String (Each.Name),
                                     New_Item => Each);
            end loop;
         end;
      end loop;
818
819
820
821
822
823
824
825
826
827
828
829
830

      --  For each partition generate a timer manager if needed
      for Node : Taste_Node of DV.Nodes loop
         for Partition : Taste_Partition of Node.Partitions loop
            declare
               Manager_Name  : constant String :=
                 To_String (Partition.Name) & "_Timer_Manager";
               Tick_PI       : constant Taste_Interface :=
                 (Name            => US ("Tick"),
                  Parent_Function => US (Manager_Name),
                  Language        => US ("Timer_Manager"),

                  RCM             => Cyclic_Operation,
831
832
                  Period_Or_MIAT  => Unsigned_Long_Long'Mod
                      (Model.Configuration.Timer_Resolution),
833
834
835
836
837
838
839
840
841
842
                  others          => <>);
               Timer_Manager : Taste_Terminal_Function :=
                 (Name     => US (Manager_Name),
                  Language => US ("Timer_Manager"),
                  others   => <>);
               Need_Timer_Manager : Boolean := False;
            begin
               Timer_Manager.Provided.Insert (Key      => Manager_Name,
                                              New_Item => Tick_PI);
               for Function_Name : String of Partition.Bound_Functions loop
843
844
845
846
847
848
849
850
                  if not Model.Interface_View.Flat_Functions.Contains
                      (Function_Name)
                  then
                     raise AADL_Parser_Error with
                        "Function """ & Function_Name
                        & """ is bound to a partition but is not found "
                        & "as terminal in the interface view";
                  end if;
851
852
853
854
855
                  for Timer_Name : String of
                    Model.Interface_View.Flat_Functions (Function_Name).Timers
                  loop
                     Need_Timer_Manager := True;
                     declare
Maxime Perrotin's avatar
Maxime Perrotin committed
856
857
858
859
                        Func_Language   : constant String :=
                          TASTE.Backend.Language_Spelling
                            (Model.Interface_View.Flat_Functions
                               (Function_Name));
860
861
862
863
864
                        Name_In_Manager : constant String :=
                          Function_Name & "_" & Timer_Name;

                        Manager_As_Remote : constant Remote_Entity :=
                          (Function_Name  => Timer_Manager.Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
865
                           Language       => US ("C"),
866
867
868
869
                           Interface_Name => US (Name_In_Manager));

                        Function_As_Remote : constant Remote_Entity :=
                          (Function_Name  => US (Function_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
870
                           Language       => US (Func_Language),
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
                           Interface_Name => US (Timer_Name));

                        Timer_PI : constant Taste_Interface :=
                          (Name              => US (Timer_Name),
                           Parent_Function   => US (Function_Name),
                           Language          =>
                             Model.Interface_View.Flat_Functions
                               (Function_Name).Language,
                           Remote_Interfaces =>
                             Remote_Entities.Empty_Vector & Manager_As_Remote,
                           Params            => Parameters.Empty_Vector,
                           RCM               => Sporadic_Operation,
                           Period_Or_Miat    => 1,
                           Is_Timer          => True,
                           others            => <>);

                        Timer_RI : constant Taste_Interface :=
                          (Name              => US (Name_In_Manager),
                           Parent_Function   => US (Manager_Name),
                           Language          => US ("Timer_Manager"),
                           Remote_Interfaces =>
                             Remote_Entities.Empty_Vector & Function_As_Remote,
                           Params            => Parameters.Empty_Vector,
                           RCM               => Sporadic_Operation,
                           Period_Or_Miat    => 1,
                           others            => <>);

                        --  Define protected functions to SET/RESET the timer
                        Set_Name_In_Manager : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
900
                          "SET_" & Function_Name & "_" & Timer_Name;
901
902

                        Reset_Name_In_Manager : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
903
                          "RESET_" & Function_Name & "_" & Timer_Name;
904
905
906
907
908
909
910
911
912
913
914
915
916

                        Set_Name_In_Function : constant String :=
                          "SET_" & Timer_Name;

                        Reset_Name_In_Function : constant String :=
                          "RESET_" & Timer_Name;

                        Set_PI_In_Manager : constant Taste_Interface :=
                          (Name              => US (Set_Name_In_Manager),
                           Parent_Function   => US (Manager_Name),
                           Language          => US ("Timer_Manager"),
                           Remote_Interfaces => Remote_Entities.Empty_Vector &
                           (Function_Name  => US (Function_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
917
                            Language       => US (Func_Language),
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
                            Interface_Name => US (Set_Name_In_Function)),
                           Params            => Parameters.Empty_Vector &
                           (Name            => US ("Val"),
                            Sort            => US ("T_UInt32"),
                            ASN1_Basic_Type => ASN1_Integer,
                            ASN1_Module     => US ("TASTE_BasicTypes"),
                            ASN1_File_Name  => US ("taste-types.asn"),
                            Encoding        => Native,
                            Direction       => Param_In),
                           RCM               => Protected_Operation,
                           Period_Or_Miat    => 1,
                           others            => <>);

                        Reset_PI_In_Manager : constant Taste_Interface :=
                          (Name              => US (Reset_Name_In_Manager),
                           Parent_Function   => US (Manager_Name),
                           Language          => US ("Timer_Manager"),
                           Remote_Interfaces => Remote_Entities.Empty_Vector &
                           (Function_Name  => US (Function_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
937
                            Language       => US (Func_Language),
938
939
940
941
942
943
944
945
946
947
948
949
950
951
                            Interface_Name => US (Reset_Name_In_Function)),
                           Params            => Parameters.Empty_Vector,
                           RCM               => Protected_Operation,
                           Period_Or_Miat    => 1,
                           others            => <>);

                        Set_RI_In_Function : constant Taste_Interface :=
                          (Name              => US (Set_Name_In_Function),
                           Parent_Function   => US (Function_Name),
                           Language          =>
                             Model.Interface_View.Flat_Functions
                               (Function_Name).Language,
                           Remote_Interfaces => Remote_Entities.Empty_Vector &
                           (Function_Name  => US (Manager_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
952
                            Language       => US ("C"),  --  manager is in C
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
                            Interface_Name => US (Set_Name_In_Manager)),
                           Params            => Parameters.Empty_Vector &
                           (Name           => US ("Val"),
                            Sort           => US ("T_UInt32"),
                            ASN1_Basic_Type => ASN1_Integer,
                            ASN1_Module    => US ("TASTE_BasicTypes"),
                            ASN1_File_Name => US ("taste-types.asn"),
                            Encoding       => Native,
                            Direction      => Param_In),
                           RCM               => Protected_Operation,
                           Is_Timer          => True,
                           Period_Or_Miat    => 1,
                           others            => <>);

                        Reset_RI_In_Function : constant Taste_Interface :=
                          (Name              => US (Reset_Name_In_Function),
                           Parent_Function   => US (Function_Name),
                           Language          =>
                             Model.Interface_View.Flat_Functions
                               (Function_Name).Language,
                           Remote_Interfaces => Remote_Entities.Empty_Vector &
                           (Function_Name  => US (Manager_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
975
                            Language       => US ("C"),  -- manager is in C
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
                            Interface_Name => US (Reset_Name_In_Manager)),
                           Params            => Parameters.Empty_Vector,
                           RCM               => Protected_Operation,
                           Period_Or_Miat    => 1,
                           Is_Timer          => True,
                           others            => <>);

                        --  Create the connections in the interface view
                        Conn_Expire : constant Connection :=
                          (Caller   => US (Manager_Name),
                           Callee   => US (Function_Name),
                           RI_Name  => US (Name_In_Manager),
                           PI_Name  => US (Timer_Name),
                           Channels => String_Vectors.Empty_Vector);

                        Conn_Set : constant Connection :=
                          (Caller   => US (Function_Name),
                           Callee   => US (Manager_Name),
                           RI_Name  => US (Set_Name_In_Function),
                           PI_Name  => US (Set_Name_In_Manager),
                           Channels => String_Vectors.Empty_Vector);

                        Conn_Reset : constant Connection :=
                          (Caller   => US (Function_Name),
                           Callee   => US (Manager_Name),
For faster browsing, not all history is shown. View entire blame