taste-aadl_parser.adb 56.8 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,
443
         Data_View          => Model.Data_View,
Maxime Perrotin's avatar
Maxime Perrotin committed
444
         Configuration      => Model.Configuration,
Maxime Perrotin's avatar
Maxime Perrotin committed
445
         others             => <>);
446
      use String_Vectors;
447
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
448
      --  Initialize the lists of nodes and partitions based on the DV
Maxime Perrotin's avatar
Maxime Perrotin committed
449
      for Node of Model.Deployment_View.Element.Nodes loop
Maxime Perrotin's avatar
Maxime Perrotin committed
450
         declare
451
452
            New_Node : CV_Node :=
              (Deployment_Node => Node, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
453
454
455
         begin
            for Partition of Node.Partitions loop
               declare
456
457
                  New_Partition : constant CV_Partition :=
                    (Deployment_Partition => Partition, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
458
459
460
461
462
463
464
465
466
467
468
               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;

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

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

500
            for PI of F.Provided loop
501
502
503
504
505
506
507
508
509
510
               --  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;

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

534
535
536
537
538
539
                        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
540
                  end loop;
541
542
                  Block.Block_Provided.Insert (Key      => To_String (PI.Name),
                                               New_Item => New_PI);
543
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
544
545
               if PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation then
                  declare
546
                     Thread : constant AADL_Thread :=
547
                       (Name                 => To_Lower (To_String (F.Name))
548
549
                        & "_" & PI.Name,
                        Partition_Name       => US (Partition_Name),
550
                        RCM                  => US (PI.RCM'Img),
Maxime Perrotin's avatar
Maxime Perrotin committed
551
                        Need_Mutex           => (F.Provided.Length > 1),
Maxime Perrotin's avatar
Maxime Perrotin committed
552
                        Entry_Port_Name      => PI.Name,
553
554
                        Ref_Protected_Block  => Block,
                        Protected_Block_Name => Block.Ref_Function.Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
555
                        Node                 => Block.Node,
556
                        PI                   => PI,
557
558
                        Output_Ports         => Get_Output_Ports
                                                    (Model, F, Partition_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
559
560
561
562
                        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
563
                  begin
Maxime Perrotin's avatar
Maxime Perrotin committed
564
565
                     CV.Nodes
                       (Node_Name).Partitions (Partition_Name).Threads.Include
Maxime Perrotin's avatar
Maxime Perrotin committed
566
567
568
569
                       (Key      => To_String (Thread.Name),
                        New_Item => Thread);
                  end;
               end if;
570
               <<next_pi>>
571
572
            end loop;
            --  Add the block to the Concurrency View
Maxime Perrotin's avatar
Maxime Perrotin committed
573
            CV.Nodes (Node_Name).Partitions (Partition_Name).Blocks.Insert
574
              (Key      => To_String (Block.Ref_Function.Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
575
               New_Item => Block);
576
         end;
577
         <<Continue>>
578
      end loop;
579

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

Maxime Perrotin's avatar
Maxime Perrotin committed
585
586
587
588
589
            --  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
590
591
592
                    "Function "
                    & To_String (B.Ref_Function.Name)
                    & " has no active caller";
Maxime Perrotin's avatar
Maxime Perrotin committed
593
594
595
               end if;
            end loop;

596
            --  Define ports at partition (process) level
597
598
            --  (ports are for all interfaces of a function not located
            --  in the same partition of the system)
599
600
601
602
603
604
605
606
607
608
609
610
611
            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 (""));
612
613
614
615
616
                     Encoding : constant Unbounded_String :=
                       (if not T.PI.Params.Is_Empty
                        then US
                          (T.PI.Params.First_Element.Encoding'Image)
                        else US (""));
617
618
619
620
621
622
623
624
625
                  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
626
627
                             and then not Partition.In_Ports.Contains
                               (To_String (T.Entry_Port_Name))
628
629
630
631
632
633
634
635
                        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,
636
                                           Encoding    => Encoding,
637
                                           Queue_Size  => US ("1"),
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
                                           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
656
657
                          (if not Out_Port.RI.Params.Is_Empty
                           then Out_Port.RI.Params.First_Element.Sort
658
                           else US (""));
659
660
661
662
663
                        Encoding : constant Unbounded_String :=
                          (if not Out_Port.RI.Params.Is_Empty
                           then US
                             (Out_Port.RI.Params.First_Element.Encoding'Image)
                           else US (""));
664
665
666
667
668
669
670
671
                     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
672
673
674
675
676
677
678
                              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
679
680
                                                     --  Out_Port.RI.Name,
                                                     Out_Port.Name,
681
682
683
684
                                                 Connected_Threads =>
                                                   String_Vectors.Empty_Vector
                                                 & To_String (T.Name),
                                                 Type_Name   => Sort,
685
                                                 Encoding => Encoding,
686
                                                 Remote_Partition_Name =>
687
                                                   Part.Unsafe_Just.Name,
688
689
                                                 Remote_Function_Name =>
                                                   Remote.Function_Name,
690
                                                 Remote_Port_Name =>
691
692
                                                   Remote.Interface_Name,
                                                 Queue_Size => US ("1")));
693
694
695
696
697
698
699
                              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;
700
701
702
703
704
705
706
707
                           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
708
709
         end loop;
      end loop;
710

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

714
   procedure Dump (Model : TASTE_Model) is
715
716
      Output_Path : constant String :=
        Model.Configuration.Output_Dir.Element & "/Debug";
717
      Output  : File_Type;
718
   begin
719
720
721
722
723
724
725
726
727
      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);

728
729
730
         if not Model.Configuration.Deployment_View.Is_Empty and
             not Model.Deployment_View.Is_Empty
         then
731
732
733
734
            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
735
            Model.Deployment_View.Element.Debug_Dump (Output);
736
737
            Close (Output);
         end if;
738
739
740
741
742
743
744
745
746
747

         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;

748
749
750
751
         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
752
         Model.Data_View.Debug_Dump (Output);
753
         Close (Output);
754

755
756
757
758
         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
759
         Model.Configuration.Debug_Dump (Output);
760
         Close (Output);
761
762
763
764

         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/");
765
      end if;
766
767
768
769
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
770
771
   end Dump;

Maxime Perrotin's avatar
Maxime Perrotin committed
772
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
773
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
774
      TASTE.Backend.Code_Generators.Generate (Model);
775
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
776
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
777
778
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
779
780
      when Error : others =>
         Errors.Display_Bug_Box (Error);
781
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
782
   end Generate_Code;
Maxime Perrotin's avatar
Maxime Perrotin committed
783

784
785
786
787
788
789
790
791
792
793
   procedure Generate_Concurrency_View (Model : TASTE_Model) is
   begin
      Model.Concurrency_View.Generate_Code;
   exception
      when Error : Concurrency_View_Error | Ada.IO_Exceptions.Name_Error =>
         Put_Error ("Concurrency View : "
                    & Ada.Exceptions.Exception_Message (Error));
         raise Quit_Taste;
   end Generate_Concurrency_View;

Maxime Perrotin's avatar
Maxime Perrotin committed
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
   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;

811
   procedure Preprocessing (Model : in out TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
812
      New_Functions : Function_Maps.Map;
813
814
815
      DV : Complete_Deployment_View := Model.Deployment_View.Element;
      use Remote_Entities,
          Parameters;
Maxime Perrotin's avatar
Maxime Perrotin committed
816
817
818
   begin
      --  Processing of user-defined functions (may return a list of new
      --  functions that will be added to the model)
819
      for F of Model.Interface_View.Flat_Functions loop
Maxime Perrotin's avatar
Maxime Perrotin committed
820
821
822
823
824
825
826
827
828
         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;
829
830
831
832
833
834
835
836
837
838
839
840
841

      --  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,
842
843
                  Period_Or_MIAT  => Unsigned_Long_Long'Mod
                      (Model.Configuration.Timer_Resolution),
844
845
846
847
848
849
850
851
852
853
                  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
854
855
856
857
858
859
860
861
                  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;
862
863
864
865
866
                  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
867
868
869
870
                        Func_Language   : constant String :=
                          TASTE.Backend.Language_Spelling
                            (Model.Interface_View.Flat_Functions
                               (Function_Name));
871
872
873
874
875
                        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
876
                           Language       => US ("C"),
877
878
879
880
                           Interface_Name => US (Name_In_Manager));

                        Function_As_Remote : constant Remote_Entity :=
                          (Function_Name  => US (Function_Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
881
                           Language       => US (Func_Language),
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
                           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
911
                          "SET_" & Function_Name & "_" & Timer_Name;
912
913

                        Reset_Name_In_Manager : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
914
                          "RESET_" & Function_Name & "_" & Timer_Name;
915
916
917
918
919
920
921
922
923
924
925
926
927

                        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
928
                            Language       => US (Func_Language),
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
                            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
948
                            Language       => US (Func_Language),
949
950
951
952
953
954
955
956
957
958
959
960
961
962
                            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
963
                            Language       => US ("C"),  --  manager is in C
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
                            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
986
                            Language       => US ("C"),  -- manager is in C
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);
For faster browsing, not all history is shown. View entire blame