taste-aadl_parser.adb 16.4 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;

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
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
   --  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;

         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;

304
305
306
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
      Result : Taste_Concurrency_View;
   begin
307
308
309
310
      --  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
311
            Block : Protected_Block :=
Maxime Perrotin's avatar
Maxime Perrotin committed
312
313
314
              (Name   => F.Name,
               Node   => Model.Deployment_View.Find_Node (To_String (F.Name)),
               others => <>);
315
316
317
318
319
320
321
322
323
324
         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
325
                  --  Check in the DV if any caller is remote
326
327
328
329
330
331
                  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
332
333
334
                        if not Remote_Node.Has_Value
                          or not Block.Node.Has_Value
                        then
335
                           raise Concurrency_View_Error with
Maxime Perrotin's avatar
Maxime Perrotin committed
336
                             "Concurrency Generation Error (parser bug?)";
337
                        end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
338

339
340
341
342
343
344
                        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
345
                  end loop;
346
                  Block.Provided.Insert (Key      => To_String (PI.Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
347
                                         New_Item => New_PI);
348
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
349
350
               if PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation then
                  declare
351
                     Thread : constant AADL_Thread :=
Maxime Perrotin's avatar
Maxime Perrotin committed
352
353
354
355
                       (Name                 => F.Name & "_" & PI.Name,
                        Entry_Port_Name      => PI.Name,
                        Protected_Block_name => Block.Name,
                        Node                 => Block.Node,
356
                        Output_Ports         => Get_Output_Ports (Model, F));
Maxime Perrotin's avatar
Maxime Perrotin committed
357
358
359
360
361
362
363
364
                  begin
                     --  Todo: add Thread.Output_Ports
                     Result.Threads.Include
                       (Key      => To_String (Thread.Name),
                        New_Item => Thread);
                  end;
               end if;

365
            end loop;
366
            Block.Required := F.Required;
367
            --  Find calling threads and add them to Block.Calling_Threads
368
            --  Add the block to the Concurrency View
369
370
            Result.Blocks.Insert (Key      => To_String (Block.Name),
                                  New_Item => Block);
371
372
373
         end;
      end loop;

374
375
376
      Model.Concurrency_View := Result;
   end Add_Concurrency_View;

377
   procedure Dump (Model : TASTE_Model) is
378
379
380
      Output_Path : constant String := Model.Configuration.Output_Dir.all
                      & "/Debug";
      Output  : File_Type;
381
   begin
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
      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
403
         Model.Data_View.Debug_Dump (Output);
404
405
406
407
408
         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
409
         Model.Configuration.Debug_Dump (Output);
410
         Close (Output);
411
412
413
414

         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/");
415
      end if;
416
417
418
419
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
420
421
   end Dump;

422
423
424
425
426
   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
427
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
428
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
429
      TASTE.Backend.Code_Generators.Generate (Model);
430
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
431
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
432
433
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
434
435
      when Error : others =>
         Errors.Display_Bug_Box (Error);
436
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
437
   end Generate_Code;
438
end TASTE.AADL_Parser;