taste-aadl_parser.adb 13.7 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
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
      Result : Taste_Concurrency_View;
   begin
251
252
253
254
      --  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
255
            Block : Protected_Block :=
Maxime Perrotin's avatar
Maxime Perrotin committed
256
257
258
              (Name   => F.Name,
               Node   => Model.Deployment_View.Find_Node (To_String (F.Name)),
               others => <>);
259
260
261
262
263
264
265
266
267
268
         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
269
                  --  Check in the DV if any caller is remote
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
                  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
                        if not Remote_Node.Has_Value then
                           raise Concurrency_View_Error with
                             "Calling function "
                             & To_String (Remote.Function_Name)
                             & ": could not find binding (parser bug?)";
                        end if;
                        if not Block.Node.Has_Value then
                           raise Concurrency_View_Error with
                             "Function "
                             & To_String (F.Name)
                             & ": cound not find binding (parser bug?)";
                        end if;
                        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
294
295
                  end loop;

296
                  Block.Provided.Insert (Key      => To_String (PI.Name),
297
298
299
                                             New_Item => New_PI);
               end;
            end loop;
300
            Block.Required := F.Required;
301
302
            --  Find calling threads and add them to New_Block.Calling_Threads
            --  Add the block to the Concurrency View
303
304
            Result.Blocks.Insert (Key      => To_String (Block.Name),
                                  New_Item => Block);
305
306
307
         end;
      end loop;

308
309
310
      Model.Concurrency_View := Result;
   end Add_Concurrency_View;

311
   procedure Dump (Model : TASTE_Model) is
312
313
314
      Output_Path : constant String := Model.Configuration.Output_Dir.all
                      & "/Debug";
      Output  : File_Type;
315
   begin
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
      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
337
         Model.Data_View.Debug_Dump (Output);
338
339
340
341
342
         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
343
         Model.Configuration.Debug_Dump (Output);
344
         Close (Output);
345
346
347
348

         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/");
349
      end if;
350
351
352
353
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
354
355
   end Dump;

356
357
358
359
360
   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
361
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
362
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
363
      TASTE.Backend.Code_Generators.Generate (Model);
364
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
365
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
366
367
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
368
369
      when Error : others =>
         Errors.Display_Bug_Box (Error);
370
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
371
   end Generate_Code;
372
end TASTE.AADL_Parser;