taste-aadl_parser.adb 18.1 KB
Newer Older
1
2
--  ************************ TASTE AADL Parser **************************  --
--  Based on Ocarina ****************************************************  --
3
--  (c) 2018 European Space Agency - maxime.perrotin@esa.int
4
5
--  LGPL license, see LICENSE file

6
with System.Assertions,
7
8
     Ada.Exceptions,
     Ada.Text_IO,
9
     Ada.Directories,
10
     Ada.Strings.Equal_Case_Insensitive,
11
     Ada.Containers,
12
     GNAT.Command_Line,
13
14
15
16
17
     Errors,
     Locations,
     Ocarina.Namet,
     Ocarina.Configuration,
     Ocarina.Files,
18
     Ocarina.Parser,
19
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
20
     TASTE.Backend.Build_Script,
Maxime Perrotin's avatar
Maxime Perrotin committed
21
     TASTE.Backend.Code_Generators,
22
     TASTE.Semantic_Check;
23
24
25

use Ada.Text_IO,
    Ada.Exceptions,
26
    Ada.Directories,
27
    Ada.Containers,
28
29
30
31
32
33
34
    Locations,
    Ocarina.Namet,
    Ocarina;

package body TASTE.AADL_Parser is

   function Initialize return Taste_Configuration is
Maxime Perrotin's avatar
Maxime Perrotin committed
35
36
37
      File_Name  : Name_Id;
      File_Descr : Location;
      Cfg        : Taste_Configuration;
38
39
40
41
   begin
      Banner;
      --  Parse arguments before initializing Ocarina, otherwise Ocarina eats
      --  some arguments (all file parameters).
Maxime Perrotin's avatar
Maxime Perrotin committed
42
      Parse_Command_Line (Cfg);
43
44
45
46
      Initialize_Ocarina;

      AADL_Language := Get_String_Name ("aadl");

Maxime Perrotin's avatar
Maxime Perrotin committed
47
      if Cfg.Interface_View.all'Length = 0 and not Cfg.Check_Data_View then
Maxime Perrotin's avatar
Maxime Perrotin committed
48
49
50
         --  Use "InterfaceView.aadl" by default, if nothing else is specified
         --  and if the tool is not only called to check the data view
         Cfg.Interface_View := Default_Interface_View'Access;
51
52
      end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
53
54
55
      --  An interface view is expected, look for it and parse it
      if Cfg.Interface_View.all'Length > 0 then
         Set_Str_To_Name_Buffer (Cfg.Interface_View.all);
56

Maxime Perrotin's avatar
Maxime Perrotin committed
57
58
59
60
61
62
63
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
              with "File not found : " & Cfg.Interface_View.all;
         end if;

         File_Descr := Ocarina.Files.Load_File (File_Name);
64

Maxime Perrotin's avatar
Maxime Perrotin committed
65
66
         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);
67

Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
70
71
72
73
74
         --  Parse TASTE_IV_Properties.aadl
         Set_Str_To_Name_Buffer ("TASTE_IV_Properties.aadl");
         File_Name  := Ocarina.Files.Search_File (Name_Find);
         File_Descr := Ocarina.Files.Load_File (File_Name);
         Interface_Root := Ocarina.Parser.Parse (AADL_Language,
                                                 Interface_Root, File_Descr);
      end if;
75

Maxime Perrotin's avatar
Maxime Perrotin committed
76
77
78
79
80
      if Cfg.Glue then
         --  Look for a deployment view (or DeploymentView.aadl by default)
         --  if the glue generation is requested. Not needed for skeletons.
         if Cfg.Deployment_View.all'Length = 0 then
            Cfg.Deployment_View := Default_Deployment_View'Access;
81
82
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
83
         Set_Str_To_Name_Buffer (Cfg.Deployment_View.all);
84
85
86
87

         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
Maxime Perrotin's avatar
Maxime Perrotin committed
88
              with "File not found : " & Cfg.Deployment_View.all;
89
90
91
92
93
94
95
96
97
98
99
         end if;

         File_Descr := Ocarina.Files.Load_File (File_Name);
         Deployment_Root := Ocarina.Parser.Parse
           (AADL_Language, Deployment_Root, File_Descr);

         if Deployment_Root = No_Node then
            raise AADL_Parser_Error with "Deployment View is incorrect";
         end if;
      end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
100
101
102
      for Each of Cfg.Other_Files loop
         --  Add other files to the Interface and (if any) deployment roots
         --  (List of files specified in the command line)
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
         Set_Str_To_Name_Buffer (Each);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error with "File not found: " & Each;
         end if;
         File_Descr := Ocarina.Files.Load_File (File_Name);

         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);
         if Deployment_Root /= No_Node then
            Deployment_Root := Ocarina.Parser.Parse
              (AADL_Language, Deployment_Root, File_Descr);
         end if;
      end loop;

Maxime Perrotin's avatar
Maxime Perrotin committed
118
119
      if Cfg.Data_View.all'Length > 0 then
         Set_Str_To_Name_Buffer (Cfg.Data_View.all);
120
121
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
122
            raise AADL_Parser_Error with "Could not find " & Cfg.Data_View.all;
123
124
         end if;
      else
Maxime Perrotin's avatar
Maxime Perrotin committed
125
         --  Try with default name (DataView.aadl)
126
127
128
         Set_Str_To_Name_Buffer (Default_Data_View);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name /= No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
129
130
131
132
            Cfg.Data_View := Default_Data_View'Access;
         elsif Cfg.Check_Data_View then
            --  No dataview found, while user asked explicitly for a check
            raise AADL_Parser_Error with "Could not find DataView.aadl";
133
134
135
136
         end if;
      end if;

      if File_Name /= No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
137
138
         Put_Info ("Parsing " & Cfg.Data_View.all);

139
140
         File_Descr := Ocarina.Files.Load_File (File_Name);

Maxime Perrotin's avatar
Maxime Perrotin committed
141
142
143
144
145
         --  Add the Data View to the Interface View root, if any
         if Interface_Root /= No_Node then
            Interface_Root := Ocarina.Parser.Parse
              (AADL_Language, Interface_Root, File_Descr);
         end if;
146
147
148
149
150
151

         --  Add the Data View to the Deployment View root, if any
         if Deployment_Root /= No_Node then
            Deployment_Root := Ocarina.Parser.Parse
               (AADL_Language, Deployment_Root, File_Descr);
         end if;
152
         --  Also parse the data view as a root component
153
         Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := False;
154
155
156
         Dataview_root := Ocarina.Parser.Parse
                            (AADL_Language, Dataview_root, File_Descr);
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
157
      return Cfg;
158
159
160
161
162
163
164
   end Initialize;

   function Parse_Project return TASTE_Model is
      Result : TASTE_Model;
   begin
      Result.Configuration := Initialize;

Maxime Perrotin's avatar
Maxime Perrotin committed
165
166
167
168
169
170
171
172
      if Interface_Root /= No_Node then
         --  Parse Interface and Deployment View
         begin
            Result.Interface_View := Parse_Interface_View (Interface_Root);
         exception
            when System.Assertions.Assert_Failure =>
               raise AADL_Parser_Error with "Interface view parsing error";
         end;
173

Maxime Perrotin's avatar
Maxime Perrotin committed
174
175
176
177
         if Result.Configuration.Deployment_View.all'Length > 0 then
            AADL_Lib.Append (Result.Configuration.Interface_View.all);
            Result.Deployment_View := Parse_Deployment_View (Deployment_Root);
         end if;
178
179
      end if;

180
181
182
      if Result.Configuration.Data_View.all'Length > 0 then
         begin
            Result.Data_View := Parse_Data_View (Dataview_root);
183
            Result.Data_View.Check_Files;
184
185
186
187
188
         exception
            when Constraint_Error =>
               raise Data_View_Error with "Update your data view!";
         end;
      end if;
189

190
191
192
      Ocarina.Configuration.Reset_Modules;
      Ocarina.Reset;

Maxime Perrotin's avatar
Maxime Perrotin committed
193
194
195
196
      if Result.Configuration.Check_Data_View then
         raise Quit_Taste;
      end if;

197
198
      Semantic_Check.Check_Model (Result);

199
200
201
202
203
204
205
      return Result;
   exception
      when Error : AADL_Parser_Error
         | Interface_Error
         | Function_Error
         | No_RCM_Error
         | Deployment_View_Error
206
         | Data_View_Error
207
         | Semantic_Check.Semantic_Error
208
         | Device_Driver_Error =>
209
         Put_Error (Exception_Message (Error));
210
211
212
         raise Quit_Taste;
      when GNAT.Command_Line.Exit_From_Command_Line =>
         New_Line;
213
214
         Put_Info ("For more information, visit " & Underline & White_Bold
                   & "https://taste.tools");
215
216
217
218
         raise Quit_Taste;
      when GNAT.Command_Line.Invalid_Switch
         | GNAT.Command_Line.Invalid_Parameter
         | GNAT.Command_Line.Invalid_Section =>
219
         Put_Error ("Invalid switch or parameter (try --help)" & No_Color);
220
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
221
222
      when Quit_Taste =>
         raise;
223
224
225
226
227
      when E : others =>
         Errors.Display_Bug_Box (E);
         raise Quit_Taste;
   end Parse_Project;

228
229
230
231
   function Find_Binding (Model : TASTE_Model;
                          F     : Unbounded_String)
                          return Option_Partition.Option is
      use Option_Partition;
232
233
      function Is_Equal (Left, Right : String) return Boolean
         renames Ada.Strings.Equal_Case_Insensitive;
234
235
236
237
238
      Function_Name : constant String := To_String (F);
   begin
      for Node of Model.Deployment_View.Nodes loop
         for Each of Node.Partitions loop
            for Binding of Each.Bound_Functions loop
239
               if Is_Equal (Binding, Function_Name) then
240
241
242
243
244
245
246
247
                  return Just (Each);
               end if;
            end loop;
         end loop;
      end loop;
      return Nothing;
   end Find_Binding;

Maxime Perrotin's avatar
Maxime Perrotin committed
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
   procedure Set_Calling_Threads (CV : in out Taste_Concurrency_View) is
      Visited_Threads : String_Sets.Set;
      procedure Rec_Add_Calling_Thread (Thread_Id : String;
                                        Block_Id  : String;
                                        Visited   : in out String_Sets.Set) is
         use String_Sets;
         Current_Thread : constant String_Sets.Set := To_Set (Thread_Id);
      begin
         if Current_Thread.Is_Subset (Of_Set => Visited) then
            return;
         else
            Visited := Visited or Current_Thread;
         end if;
         --  First add thread to its corresponding protected function
         CV.Blocks (Block_Id).Calling_Threads.Insert (Thread_Id);
         --  Then recurse on its (Un)protected RIs.
         for RI of CV.Blocks (Block_Id).Required loop
            if RI.RCM = Protected_Operation or RI.RCM = Unprotected_Operation
            then
               for Remote of RI.Remote_Interfaces loop
                  Rec_Add_Calling_Thread
                    (Thread_Id => Thread_Id,
                     Block_Id  => To_String (Remote.Function_Name),
                     Visited   => Visited);
               end loop;
            end if;
         end loop;
      end Rec_Add_Calling_Thread;
   begin
      for Each of CV.Threads loop
         Rec_Add_Calling_Thread (Thread_Id => To_String (Each.Name),
                                 Block_Id  => To_String
                                   (Each.Protected_Block_Name),
                                 Visited   => Visited_Threads);
      end loop;
   end Set_Calling_Threads;

285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
   --  Find the output ports of a thread by following the connections
   function Get_Output_Ports (Model : TASTE_Model;
                              F     : Taste_Terminal_Function) return Ports.Map
   is
      Result            : Ports.Map;
      Visited_Functions : String_Sets.Set;
      procedure Rec_Find_Thread (Ports_Map  : in out Ports.Map;
                                 Visited    : in out String_Sets.Set;
                                 Func       : Taste_Terminal_Function) is
         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
305
306
307
308
         if Func.Is_Type then
            --  Ignore function types, only work with instances
            return;
         end if;
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

         for RI of Func.Required loop
            if RI.RCM = Unprotected_Operation or RI.RCM = Protected_Operation
            then
               Rec_Find_Thread (Ports_Map => Ports_Map,
                                Visited   => Visited,
                                Func      =>
                                  Model.Interface_View.Flat_Functions
                                  (To_String
                          (RI.Remote_Interfaces.First_Element.Function_Name)));
            else
               declare
                  --  Assume only one remote connection per RI
                  --  Have to iterate on Remote_Interfaces if that changes
                  Dist  : constant Remote_Entity :=
                    RI.Remote_Interfaces.First_Element;
                  New_P : constant Port :=
                    (Remote_Thread =>
                       Dist.Function_Name & "_" & Dist.Interface_Name,
                     Remote_PI     => Dist.Interface_Name);
               begin
                  Ports_Map.Include
                    (Key => To_String
                       (New_P.Remote_Thread & "_" & New_P.Remote_PI),
                     New_Item => New_P);
               end;
            end if;
         end loop;
      end Rec_Find_Thread;
   begin
      Rec_Find_Thread (Ports_Map => Result,
                       Visited   => Visited_Functions,
                       Func      => F);
      return Result;
   end Get_Output_Ports;

345
346
347
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
      Result : Taste_Concurrency_View;
   begin
348
349
350
351
      --  Create one thread per Cyclic and Sporadic interface
      --  Create one protected block per application code
      for F of Model.Interface_View.Flat_Functions loop
         declare
352
            Block : Protected_Block :=
Maxime Perrotin's avatar
Maxime Perrotin committed
353
354
355
              (Name   => F.Name,
               Node   => Model.Deployment_View.Find_Node (To_String (F.Name)),
               others => <>);
356
357
358
359
360
361
362
363
364
365
         begin
            for PI of F.Provided loop
               declare
                  New_PI : Protected_Block_PI := (Name   => PI.Name,
                                                  PI     => PI,
                                                  others => <>);
               begin
                  New_PI.PI.RCM := (if F.Provided.Length = 1
                                    then Unprotected_Operation
                                    else Protected_Operation);
Maxime Perrotin's avatar
Maxime Perrotin committed
366
                  --  Check in the DV if any caller is remote
367
368
369
370
371
372
                  for Remote of PI.Remote_Interfaces loop
                     declare
                        Remote_Node : constant Option_Node.Option :=
                          Model.Deployment_View.Find_Node
                            (To_String (Remote.Function_Name));
                     begin
Maxime Perrotin's avatar
Maxime Perrotin committed
373
374
375
                        if not Remote_Node.Has_Value
                          or not Block.Node.Has_Value
                        then
376
                           raise Concurrency_View_Error with
Maxime Perrotin's avatar
Maxime Perrotin committed
377
                             "Concurrency Generation Error (parser bug?)";
378
                        end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
379

380
381
382
383
384
385
                        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
386
                  end loop;
387
                  Block.Provided.Insert (Key      => To_String (PI.Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
388
                                         New_Item => New_PI);
389
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
390
391
               if PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation then
                  declare
392
                     Thread : constant AADL_Thread :=
Maxime Perrotin's avatar
Maxime Perrotin committed
393
394
395
396
                       (Name                 => F.Name & "_" & PI.Name,
                        Entry_Port_Name      => PI.Name,
                        Protected_Block_name => Block.Name,
                        Node                 => Block.Node,
397
                        Output_Ports         => Get_Output_Ports (Model, F));
Maxime Perrotin's avatar
Maxime Perrotin committed
398
399
400
401
402
403
404
                  begin
                     Result.Threads.Include
                       (Key      => To_String (Thread.Name),
                        New_Item => Thread);
                  end;
               end if;

405
            end loop;
406
            Block.Required := F.Required;
407
            --  Add the block to the Concurrency View
408
409
            Result.Blocks.Insert (Key      => To_String (Block.Name),
                                  New_Item => Block);
410
411
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
412
413
      --  Find and set protected blocks calling threads
      Set_Calling_Threads (Result);
414

415
416
417
      Model.Concurrency_View := Result;
   end Add_Concurrency_View;

418
   procedure Dump (Model : TASTE_Model) is
419
420
421
      Output_Path : constant String := Model.Configuration.Output_Dir.all
                      & "/Debug";
      Output  : File_Type;
422
   begin
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
      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);

         if Model.Configuration.Deployment_View.all'Length > 0 then
            Create (File => Output,
                    Mode => Out_File,
                    Name => Output_Path & "/DeploymentView.dump");
            Put_Info ("Dump of the Deployment View");
            Model.Deployment_View.Debug_Dump (Output);
            Close (Output);
         end if;
         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
444
         Model.Data_View.Debug_Dump (Output);
445
446
447
448
449
         Close (Output);
         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
450
         Model.Configuration.Debug_Dump (Output);
451
         Close (Output);
452
453
454
455

         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/");
456
      end if;
457
458
459
460
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
461
462
   end Dump;

463
464
465
466
467
   procedure Generate_Build_Script (Model : TASTE_Model) is
   begin
      TASTE.Backend.Build_Script.Generate (Model);
   end Generate_Build_Script;

Maxime Perrotin's avatar
Maxime Perrotin committed
468
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
469
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
470
      TASTE.Backend.Code_Generators.Generate (Model);
471
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
472
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
473
474
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
475
476
      when Error : others =>
         Errors.Display_Bug_Box (Error);
477
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
478
   end Generate_Code;
479
end TASTE.AADL_Parser;