taste-aadl_parser.adb 27.6 KB
Newer Older
1
2
--  ************************ TASTE AADL Parser **************************  --
--  Based on Ocarina ****************************************************  --
3
--  (c) 2019 Maxime Perrotin / 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
     Ada.Characters.Handling,   -- Contains "To_Lower"
13
     GNAT.Command_Line,
14
15
16
17
18
     Errors,
     Locations,
     Ocarina.Namet,
     Ocarina.Configuration,
     Ocarina.Files,
19
     Ocarina.Parser,
20
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
21
     TASTE.Backend,
Maxime Perrotin's avatar
Maxime Perrotin committed
22
     TASTE.Backend.Build_Script,
Maxime Perrotin's avatar
Maxime Perrotin committed
23
     TASTE.Backend.Code_Generators,
24
     TASTE.Semantic_Check;
25
26
27

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

package body TASTE.AADL_Parser is

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

      AADL_Language := Get_String_Name ("aadl");

51
      if Cfg.Interface_View.Is_Empty and not Cfg.Check_Data_View then
Maxime Perrotin's avatar
Maxime Perrotin committed
52
53
         --  Use "InterfaceView.aadl" by default, if nothing else is specified
         --  and if the tool is not only called to check the data view
54
55
         --  Cfg.Interface_View := Default_Interface_View'Access;
         Cfg.Interface_View := To_Holder (Default_Interface_View);
56
57
      end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
58
      --  An interface view is expected, look for it and parse it
59
60
      if not Cfg.Interface_View.Is_Empty then
         Set_Str_To_Name_Buffer (Cfg.Interface_View.Element);
61

Maxime Perrotin's avatar
Maxime Perrotin committed
62
63
64
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
65
66
              with "Interface View file not found : "
              & Cfg.Interface_View.Element;
Maxime Perrotin's avatar
Maxime Perrotin committed
67
68
69
         end if;

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

Maxime Perrotin's avatar
Maxime Perrotin committed
71
72
         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);
73

Maxime Perrotin's avatar
Maxime Perrotin committed
74
75
76
77
78
79
         --  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);
Maxime Perrotin's avatar
Maxime Perrotin committed
80
81
82
         if Interface_Root = No_Node then
            raise AADL_Parser_Error with "Interface view is incorrect";
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
83
      end if;
84

Maxime Perrotin's avatar
Maxime Perrotin committed
85
86
87
      if Cfg.Glue then
         --  Look for a deployment view (or DeploymentView.aadl by default)
         --  if the glue generation is requested. Not needed for skeletons.
88
89
         if Cfg.Deployment_View.Is_Empty then
            Cfg.Deployment_View := To_Holder (Default_Deployment_View);
90
91
         end if;

92
         Set_Str_To_Name_Buffer (Cfg.Deployment_View.Element);
93
94
95
96

         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
97
98
              with "Deployment View file not found : "
              & Cfg.Deployment_View.Element;
99
100
101
102
103
104
105
106
107
108
109
         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
110
111
112
      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)
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
         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;

128
129
      if not Cfg.Data_View.Is_Empty then
         Set_Str_To_Name_Buffer (Cfg.Data_View.Element);
130
131
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
132
133
            raise AADL_Parser_Error
              with "Could not find " & Cfg.Data_View.Element;
134
135
         end if;
      else
Maxime Perrotin's avatar
Maxime Perrotin committed
136
         --  Try with default name (DataView.aadl)
137
138
139
         Set_Str_To_Name_Buffer (Default_Data_View);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name /= No_Name then
140
            Cfg.Data_View := To_Holder (Default_Data_View);
Maxime Perrotin's avatar
Maxime Perrotin committed
141
142
143
         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";
144
145
146
147
         end if;
      end if;

      if File_Name /= No_Name then
148
         Put_Info ("Parsing " & Cfg.Data_View.Element);
Maxime Perrotin's avatar
Maxime Perrotin committed
149

150
151
         File_Descr := Ocarina.Files.Load_File (File_Name);

Maxime Perrotin's avatar
Maxime Perrotin committed
152
153
154
155
156
         --  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;
157
158
159
160
161
162

         --  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;
163
         --  Also parse the data view as a root component
164
         Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := False;
165
166
167
         Dataview_root := Ocarina.Parser.Parse
                            (AADL_Language, Dataview_root, File_Descr);
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
168
      return Cfg;
169
170
171
172
173
174
175
   end Initialize;

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

Maxime Perrotin's avatar
Maxime Perrotin committed
176
177
178
179
180
181
182
183
      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;
184

185
186
187
188
         if not Result.Configuration.No_Stdlib then
            AADL_Lib.Append ("ocarina_components.aadl");
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
189
190
191
         if Deployment_Root /= No_Node
           and not Result.Configuration.Deployment_View.Is_Empty
         then
192
            AADL_Lib.Append (Result.Configuration.Interface_View.Element);
Maxime Perrotin's avatar
Maxime Perrotin committed
193
            Result.Deployment_View := Parse_Deployment_View (Deployment_Root);
194
            Result.Deployment_View.Fix_Bus_Connections (Result.Interface_View);
Maxime Perrotin's avatar
Maxime Perrotin committed
195
         end if;
196
197
      end if;

198
      if not Result.Configuration.Data_View.Is_Empty then
199
200
         begin
            Result.Data_View := Parse_Data_View (Dataview_root);
201
            Result.Data_View.Check_Files;
202
203
204
205
206
         exception
            when Constraint_Error =>
               raise Data_View_Error with "Update your data view!";
         end;
      end if;
207

208
209
210
      Ocarina.Configuration.Reset_Modules;
      Ocarina.Reset;

Maxime Perrotin's avatar
Maxime Perrotin committed
211
212
213
214
      if Result.Configuration.Check_Data_View then
         raise Quit_Taste;
      end if;

215
216
      Semantic_Check.Check_Model (Result);

217
218
219
220
221
222
223
      return Result;
   exception
      when Error : AADL_Parser_Error
         | Interface_Error
         | Function_Error
         | No_RCM_Error
         | Deployment_View_Error
224
         | Data_View_Error
225
         | Semantic_Check.Semantic_Error
226
         | Device_Driver_Error =>
227
         Put_Error (Exception_Message (Error));
228
229
230
         raise Quit_Taste;
      when GNAT.Command_Line.Exit_From_Command_Line =>
         New_Line;
231
232
         Put_Info ("For more information, visit " & Underline & White_Bold
                   & "https://taste.tools");
233
234
235
236
         raise Quit_Taste;
      when GNAT.Command_Line.Invalid_Switch
         | GNAT.Command_Line.Invalid_Parameter
         | GNAT.Command_Line.Invalid_Section =>
237
         Put_Error ("Invalid switch or parameter (try --help)" & No_Color);
238
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
239
240
      when Quit_Taste =>
         raise;
241
242
243
244
245
      when E : others =>
         Errors.Display_Bug_Box (E);
         raise Quit_Taste;
   end Parse_Project;

246
247
248
249
   function Find_Binding (Model : TASTE_Model;
                          F     : Unbounded_String)
                          return Option_Partition.Option is
      use Option_Partition;
250
251
      function Is_Equal (Left, Right : String) return Boolean
         renames Ada.Strings.Equal_Case_Insensitive;
252
253
254
255
256
      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
257
               if Is_Equal (Binding, Function_Name) then
258
259
260
261
262
263
264
265
                  return Just (Each);
               end if;
            end loop;
         end loop;
      end loop;
      return Nothing;
   end Find_Binding;

Maxime Perrotin's avatar
Maxime Perrotin committed
266
   procedure Set_Calling_Threads (Partition : in out CV_Partition) is
Maxime Perrotin's avatar
Maxime Perrotin committed
267
      procedure Rec_Add_Calling_Thread (Thread_Id : String;
Maxime Perrotin's avatar
Maxime Perrotin committed
268
                                        Block_Id  : String) is
Maxime Perrotin's avatar
Maxime Perrotin committed
269
270
      begin
         --  First add thread to its corresponding protected function
Maxime Perrotin's avatar
Maxime Perrotin committed
271
272
         --  Stop recursion if thread is already there...
         if not String_Sets.To_Set (Thread_Id).Is_Subset
Maxime Perrotin's avatar
Maxime Perrotin committed
273
           (Of_Set => Partition.Blocks (Block_Id).Calling_Threads)
Maxime Perrotin's avatar
Maxime Perrotin committed
274
         then
Maxime Perrotin's avatar
Maxime Perrotin committed
275
            Partition.Blocks (Block_Id).Calling_Threads.Insert (Thread_Id);
Maxime Perrotin's avatar
Maxime Perrotin committed
276
277
278
279
         else
            return;
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
280
         --  Then recurse on its (Un)protected RIs.
Maxime Perrotin's avatar
Maxime Perrotin committed
281
         for RI of Partition.Blocks (Block_Id).Required loop
Maxime Perrotin's avatar
Maxime Perrotin committed
282
283
284
285
286
            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,
Maxime Perrotin's avatar
Maxime Perrotin committed
287
                     Block_Id  => To_String (Remote.Function_Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
288
289
290
291
292
               end loop;
            end if;
         end loop;
      end Rec_Add_Calling_Thread;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
293
      for Each of Partition.Threads loop
Maxime Perrotin's avatar
Maxime Perrotin committed
294
295
         Rec_Add_Calling_Thread (Thread_Id => To_String (Each.Name),
                                 Block_Id  => To_String
Maxime Perrotin's avatar
Maxime Perrotin committed
296
                                   (Each.Protected_Block_Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
297
298
299
      end loop;
   end Set_Calling_Threads;

300
301
302
303
304
305
   --  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;
306

307
308
309
310
311
312
313
314
315
316
317
318
319
320
      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
321
322
323
324
         if Func.Is_Type then
            --  Ignore function types, only work with instances
            return;
         end if;
325
326

         for RI of Func.Required loop
Maxime Perrotin's avatar
Maxime Perrotin committed
327
328
329
330
            if RI.Remote_Interfaces.Is_Empty then
               goto Continue;
            end if;

331
332
333
334
335
336
337
338
339
340
341
342
            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
343
344

                  Dist      : constant Remote_Entity :=
345
                    RI.Remote_Interfaces.First_Element;
346
                  Remote_Thread_Name : constant Unbounded_String :=
347
348
                    To_Lower (To_String (Dist.Function_Name))
                    & "_" & Dist.Interface_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
349
                  Port_Name : constant Unbounded_String := RI.Name;
350
                  New_P     : constant Thread_Port :=
351
352
                    (Name          => Port_Name,
                     Remote_Thread => Remote_Thread_Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
353
354
                     Remote_PI     => Dist.Interface_Name,
                     RI            => RI);
355
               begin
356
357
                  Ports_Map.Include (Key      => To_String (Port_Name),
                                     New_Item => New_P);
358
359
               end;
            end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
360
            <<Continue>>
361
362
363
364
365
366
367
368
369
         end loop;
      end Rec_Find_Thread;
   begin
      Rec_Find_Thread (Ports_Map => Result,
                       Visited   => Visited_Functions,
                       Func      => F);
      return Result;
   end Get_Output_Ports;

370
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
371
372
373
      CV : Taste_Concurrency_View :=
        (Base_Template_Path => Model.Configuration.Binary_Path,
         Base_Output_Path   => Model.Configuration.Output_Dir,
374
         Deployment         => Model.Deployment_View,
Maxime Perrotin's avatar
Maxime Perrotin committed
375
         Configuration      => Model.Configuration,
Maxime Perrotin's avatar
Maxime Perrotin committed
376
         others             => <>);
377
      use String_Vectors;
378
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
379
380
381
      --  Initialize the lists of nodes and partitions based on the DV
      for Node of Model.Deployment_View.Nodes loop
         declare
382
383
            New_Node : CV_Node :=
              (Deployment_Node => Node, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
384
385
386
         begin
            for Partition of Node.Partitions loop
               declare
387
388
                  New_Partition : constant CV_Partition :=
                    (Deployment_Partition => Partition, others => <>);
Maxime Perrotin's avatar
Maxime Perrotin committed
389
390
391
392
393
394
395
396
397
398
399
               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;

400
401
      --  Create one thread per Cyclic and Sporadic interface
      --  Create one protected block per application code
Maxime Perrotin's avatar
Maxime Perrotin committed
402
      --  and map them on the Concurrency View nodes/partitions
403
      for F of Model.Interface_View.Flat_Functions loop
404
405
406
         if F.Is_Type then
            goto Continue;
         end if;
407
         declare
Maxime Perrotin's avatar
Maxime Perrotin committed
408
409
410
411
412
413
414
415
416
417
418
419
420
            Function_Name : constant String := To_String (F.Name);
            Node : constant Option_Node.Option :=
              Model.Deployment_View.Find_Node (Function_Name);
            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 "");

421
            Block : Protected_Block :=
422
              (Name     => F.Name,
Maxime Perrotin's avatar
Maxime Perrotin committed
423
               Language => US (TASTE.Backend.Language_Spelling (F)),
424
425
               Node     => Node,
               others   => <>);
426
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
427
428
429
430
431
            if not Node.Has_Value then
               --  Ignore functions that are not mapped to a node/partition
               goto Continue;
            end if;

432
            for PI of F.Provided loop
433
434
435
436
437
438
439
440
441
442
               --  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;

443
444
445
446
447
               declare
                  New_PI : Protected_Block_PI := (Name   => PI.Name,
                                                  PI     => PI,
                                                  others => <>);
               begin
448
449
450
                  --  Convert cyclic/sporadic to Protected
                  New_PI.PI.RCM := (if PI.RCM = Unprotected_Operation
                                    then Unprotected_Operation
451
                                    else Protected_Operation);
Maxime Perrotin's avatar
Maxime Perrotin committed
452
                  --  Check in the DV if any caller is remote
453
454
455
456
457
458
                  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
459
460
461
                        if not Remote_Node.Has_Value
                          or not Block.Node.Has_Value
                        then
462
                           raise Concurrency_View_Error with
Maxime Perrotin's avatar
Maxime Perrotin committed
463
                             "Concurrency Generation Error (parser bug?)";
464
                        end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
465

466
467
468
469
470
471
                        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
472
                  end loop;
473
                  Block.Provided.Insert (Key      => To_String (PI.Name),
Maxime Perrotin's avatar
Maxime Perrotin committed
474
                                         New_Item => New_PI);
475
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
476
477
               if PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation then
                  declare
478
                     Thread : constant AADL_Thread :=
479
                       (Name                 => To_Lower (To_String (F.Name))
480
481
                        & "_" & PI.Name,
                        Partition_Name       => US (Partition_Name),
482
                        RCM                  => US (PI.RCM'Img),
Maxime Perrotin's avatar
Maxime Perrotin committed
483
                        Need_Mutex           => (F.Provided.Length > 1),
Maxime Perrotin's avatar
Maxime Perrotin committed
484
485
486
                        Entry_Port_Name      => PI.Name,
                        Protected_Block_name => Block.Name,
                        Node                 => Block.Node,
487
                        PI                   => PI,
488
                        Output_Ports         => Get_Output_Ports (Model, F));
Maxime Perrotin's avatar
Maxime Perrotin committed
489
                  begin
Maxime Perrotin's avatar
Maxime Perrotin committed
490
491
                     CV.Nodes
                       (Node_Name).Partitions (Partition_Name).Threads.Include
Maxime Perrotin's avatar
Maxime Perrotin committed
492
493
494
495
                       (Key      => To_String (Thread.Name),
                        New_Item => Thread);
                  end;
               end if;
496
               <<next_pi>>
497
            end loop;
498
            Block.Required := F.Required;
499
            --  Add the block to the Concurrency View
Maxime Perrotin's avatar
Maxime Perrotin committed
500
501
502
            CV.Nodes (Node_Name).Partitions (Partition_Name).Blocks.Insert
              (Key      => To_String (Block.Name),
               New_Item => Block);
503
         end;
504
         <<Continue>>
505
      end loop;
506

Maxime Perrotin's avatar
Maxime Perrotin committed
507
508
      for Node of CV.Nodes loop
         for Partition of Node.Partitions loop
509
            --  Find and set protected blocks calling threads
Maxime Perrotin's avatar
Maxime Perrotin committed
510
            Set_Calling_Threads (Partition);
511

Maxime Perrotin's avatar
Maxime Perrotin committed
512
513
514
515
516
517
518
519
520
            --  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
                    "Function " & To_String (B.Name) & " has no active caller";
               end if;
            end loop;

521
            --  Define ports at partition (process) level
522
523
            --  (ports are for all interfaces of a function not located
            --  in the same partition of the system)
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
            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 (""));
                  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
546
547
                             and then not Partition.In_Ports.Contains
                               (To_String (T.Entry_Port_Name))
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
                        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,
                                           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
574
575
                          (if not Out_Port.RI.Params.Is_Empty
                           then Out_Port.RI.Params.First_Element.Sort
576
577
578
579
580
581
582
583
584
                           else US (""));
                     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
585
586
587
588
589
590
591
592
593
594
595
596
597
                              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   =>
                                                     Out_Port.RI.Name,
                                                 Connected_Threads =>
                                                   String_Vectors.Empty_Vector
                                                 & To_String (T.Name),
                                                 Type_Name   => Sort,
                                                 Remote_Partition_Name =>
598
599
600
                                                   Part.Unsafe_Just.Name,
                                                 Remote_Port_Name =>
                                                   Remote.Interface_Name));
601
602
603
604
605
606
607
                              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;
608
609
610
611
612
613
614
615
                           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
616
617
         end loop;
      end loop;
618

Maxime Perrotin's avatar
Maxime Perrotin committed
619
      Model.Concurrency_View := CV;
620
621
   end Add_Concurrency_View;

622
   procedure Dump (Model : TASTE_Model) is
623
624
      Output_Path : constant String :=
        Model.Configuration.Output_Dir.Element & "/Debug";
625
      Output  : File_Type;
626
   begin
627
628
629
630
631
632
633
634
635
      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);

636
         if not Model.Configuration.Deployment_View.Is_Empty then
637
638
639
640
641
642
643
            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;
644
645
646
647
648
649
650
651
652
653

         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;

654
655
656
657
         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
658
         Model.Data_View.Debug_Dump (Output);
659
         Close (Output);
660

661
662
663
664
         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
665
         Model.Configuration.Debug_Dump (Output);
666
         Close (Output);
667
668
669
670

         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/");
671
      end if;
672
673
674
675
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
676
677
   end Dump;

678
679
680
681
682
   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
683
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
684
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
685
      TASTE.Backend.Code_Generators.Generate (Model);
686
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
687
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
688
689
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
690
691
      when Error : others =>
         Errors.Display_Bug_Box (Error);
692
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
693
   end Generate_Code;
694
end TASTE.AADL_Parser;