1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--               OCARINA.BACKENDS.LNT.TREE_GENERATOR_THREAD                 --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2016-2019 ESA & ISAE, 2019-2020 OpenAADL           --
10
--                                                                          --
11
-- Ocarina  is free software; you can redistribute it and/or modify under   --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
15
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
16
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
--                    Ocarina is maintained by OpenAADL team                --
28
--                              (info@openaadl.org)                         --
29
--                                                                          --
30
------------------------------------------------------------------------------
31

32
with Ocarina.Namet; use Ocarina.Namet;
33

34
with Ocarina.Backends;
35
with Ocarina.Backends.LNT.Nutils;
36
with Ocarina.Backends.LNT.Nodes;
37
with Ocarina.Backends.LNT.Components;
38

39
with Ocarina.ME_AADL;
40
with Ocarina.ME_AADL.AADL_Instances.Nodes;
41
with Ocarina.ME_AADL.AADL_Instances.Nutils;
42
with Ocarina.ME_AADL.AADL_Instances.Entities;
43
with Ocarina.ME_AADL_BA.BA_Tree.Nodes;
44
--  with Ocarina.ME_AADL_BA.BA_Tree.Debug;
45
with Ocarina.Analyzer.AADL_BA;
46
with Ocarina.ME_AADL_BA.BA_Tree.Nutils;
47

48
with Utils; use Utils;
49

50
use Ocarina.Backends.LNT.Components;
51

52
use Ocarina.ME_AADL;
53
use Ocarina.ME_AADL.AADL_Instances.Entities;
54

55
with Ocarina.ME_AADL.AADL_Instances.Debug;
56
use Ocarina.ME_AADL.AADL_Instances.Debug;
57
with Ada.Text_IO; use Ada.Text_IO;
58

59
package body Ocarina.Backends.LNT.Tree_Generator_Thread is
60

61
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
62
   package AINu renames Ocarina.ME_AADL.AADL_Instances.Nutils;
63
   use AIN;
64

65
   package BLN renames Ocarina.Backends.LNT.Nodes;
66
   package BLNu renames Ocarina.Backends.LNT.Nutils;
67
   use BLN;
68
   use BLNu;
69

70
   package BATN renames Ocarina.ME_AADL_BA.BA_Tree.Nodes;
71
   package BANu renames Ocarina.ME_AADL_BA.BA_Tree.Nutils;
72

73
   procedure Visit (E : Node_Id);
74
   procedure Visit_Architecture_Instance (E : Node_Id);
75
   procedure Visit_Component_Instance (E : Node_Id);
76
   procedure Visit_System_Instance (E : Node_Id);
77
   procedure Visit_Process_Instance (E : Node_Id);
78
   procedure Visit_Thread_Instance (E : Node_Id);
79
   procedure Visit_Device_Instance (E : Node_Id);
80
   Module_Node : Node_Id := No_Node;
81
   Definitions_List : List_Id := No_List;
82
   Modules_List : List_Id := No_List;
83
   Predefined_Functions_List : List_Id := No_List;
84

85 1
   function Generate_LNT_Thread (AADL_Tree : Node_Id)
86
     return Node_Id is
87
   begin
88 1
      Put_Line ("Begin Thread");
89 1
      Visit (AADL_Tree);
90 1
      return Module_Node;
91
   end Generate_LNT_Thread;
92

93
   -----------
94
   -- Visit --
95
   -----------
96 1
   procedure Visit (E : Node_Id) is
97
   begin
98
      case AIN.Kind (E) is
99

100 1
      when K_Architecture_Instance =>
101 1
         Visit_Architecture_Instance (E);
102

103 1
      when K_Component_Instance =>
104 1
         Visit_Component_Instance (E);
105

106 0
      when others =>
107 0
         null;
108
      end case;
109 1
   end Visit;
110

111
   ---------------------------------
112
   -- Visit_Architecture_Instance --
113
   ---------------------------------
114 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
115 1
      N : constant Node_Id := Root_System (E);
116
   begin
117 1
      Module_Node := Make_Module_Definition
118 1
       (New_Identifier (Get_String_Name ("_Threads"),
119 1
                        Get_Name_String (System_Name)));
120 1
      Definitions_List := New_List;
121 1
      Modules_List := New_List (Make_Identifier ("Types"));
122 1
      Predefined_Functions_List := New_List;
123 1
      Visit (N);
124 1
      Set_Definitions (Module_Node, Definitions_List);
125 1
      Set_Modules (Module_Node, Modules_List);
126 1
      Set_Predefined_Functions (Module_Node, Predefined_Functions_List);
127 1
   end Visit_Architecture_Instance;
128

129
   ------------------------------
130
   -- Visit_Component_Instance --
131
   ------------------------------
132 1
   procedure Visit_Component_Instance (E : Node_Id) is
133
      Category : constant Component_Category
134 1
        := Get_Category_Of_Component (E);
135
   begin
136
      case Category is
137 1
            when CC_System =>
138 1
               Visit_System_Instance (E);
139 1
            when CC_Process =>
140 1
               Visit_Process_Instance (E);
141 1
            when CC_Thread =>
142 1
               Visit_Thread_Instance (E);
143 1
            when CC_Device =>
144 1
               Visit_Device_Instance (E);
145 1
            when others =>
146 1
               null;
147 1
      end case;
148 1
   end Visit_Component_Instance;
149

150
   ---------------------------
151
   -- Visit_System_Instance --
152
   ---------------------------
153 1
   procedure Visit_System_Instance (E : Node_Id) is
154 1
      S : Node_Id;
155 1
      Cs : Node_Id;
156
   begin
157
      --  Visit all the subcomponents of the system
158 1
      if not AINU.Is_Empty (Subcomponents (E)) then
159 1
         S := AIN.First_Node (Subcomponents (E));
160 1
         while Present (S) loop
161 1
            Cs := Corresponding_Instance (S);
162 1
            Visit (Cs);
163 1
            S := AIN.Next_Node (S);
164 1
         end loop;
165
      end if;
166

167 1
   end Visit_System_Instance;
168

169
   ----------------------------
170
   -- Visit_Process_Instance --
171
   ----------------------------
172 1
   procedure Visit_Process_Instance (E : Node_Id) is
173 1
      S : Node_Id;
174 1
      Cs : Node_Id;
175 1
      Ns : Name_Id;
176
   begin
177
      --  Visit all the subcomponents of the process
178 1
      if not AINU.Is_Empty (Subcomponents (E)) then
179 1
         S := AIN.First_Node (Subcomponents (E));
180 1
         while Present (S) loop
181

182 1
            Cs := Corresponding_Instance (S);
183 1
            Ns := AIN.Name (AIN.Identifier (Cs));
184 1
            if No (Node_Id ((Get_Name_Table_Info (Ns)))) then
185 1
               Set_Name_Table_Info (Ns, Int (Cs));
186 1
               Visit (Cs);
187
            end if;
188 1
            S := AIN.Next_Node (S);
189 1
         end loop;
190
      end if;
191 1
   end Visit_Process_Instance;
192

193
   ----------------------------
194
   -- Visit_Thread_Instance --
195
   ----------------------------
196 1
   procedure Visit_Thread_Instance (E : Node_Id) is
197 1
      S : Node_Id;
198 1
      BA : Node_Id;
199 1
      N : Node_Id;
200 1
      N_Activation : Node_Id;
201 1
      N_Port : Node_Id;
202 1
      N_Variable_Port : Node_Id;
203 1
      Aux_N_Variable_Port : Node_Id;
204 1
      Gate : Node_Id;
205 1
      Communication : Node_Id;
206 1
      Aux_Communication : Node_Id;
207 1
      L_Out_Port : List_Id;
208 1
      L_In_Port : List_Id;
209 1
      L_End : List_Id;
210 1
      L_Begin : List_Id;
211 1
      L_All : List_Id;
212 1
      L_Gates : List_Id;
213 1
      L_Statements : List_Id;
214
      --  When BA
215 1
      Has_BA : Boolean := false;
216 1
      Si : Node_Id;
217 1
      N_Si : Node_Id;
218 1
      Vi : Node_Id;
219 1
      N_Vi : Node_Id;
220 1
      Var_Dec : List_Id;
221 1
      Out_Loop : List_Id;
222 1
      In_Select : List_Id;
223 1
      Variable : Node_Id;
224 1
      Ti : Node_Id;
225 1
      Source_Transition_List : List_Id;
226 1
      Destination_Transition : Node_Id;
227

228
      Thread_Identifier : constant Name_Id
229 1
        := AIN.Display_Name (AIN.Identifier (E));
230
   begin
231 1
      N_Activation := Make_Identifier ("ACTIVATION");
232 1
      LNT_States_List := New_List;
233 1
      Var_Dec := New_List;
234 1
      Out_Loop := New_List;
235 1
      L_Out_Port := New_List;
236 1
      L_In_Port := New_List;
237 1
      L_Begin := New_List (Make_Communication_Statement
238 1
           (N_Activation, New_List (Make_Identifier
239
            ("T_Dispatch_Preemption"))));
240 1
      L_All := New_List (Make_Communication_Statement
241 1
           (N_Activation, New_List (Make_Identifier
242
            ("T_Dispatch_Completion"))));
243 1
      L_End := New_List (Make_Communication_Statement
244 1
           (N_Activation, New_List (Make_Identifier
245
            ("T_Preemption_Completion"))));
246 1
      L_Gates := New_List (Make_Gate_Declaration
247 1
       (Make_Identifier ("LNT_Channel_Dispatch"), N_Activation));
248

249
      --  Visit all the subcomponents of the thread
250 1
      if not AINU.Is_Empty (Subcomponents (E)) then
251 1
         S := AIN.First_Node (Subcomponents (E));
252 1
         while Present (S) loop
253 1
            Visit (Corresponding_Instance (S));
254 1
            S := AIN.Next_Node (S);
255 1
         end loop;
256
      end if;
257
      --  BA mapping
258 1
      if not AINU.Is_Empty (AIN.Annexes (E)) then
259 1
         S := AIN.First_Node (AIN.Annexes (E));
260
         loop
261 1
            if (To_Upper (AIN.Display_Name (AIN.Identifier (S))) =
262 1
                To_Upper (Get_String_Name ("behavior_specification")))
263 1
               and then Present (AIN.Corresponding_Annex (S))
264
            then
265 1
               Has_BA := true;
266 1
               BA := AIN.Corresponding_Annex (S);
267 1
               if not BANu.Is_Empty (BATN.States (BA)) then
268 1
                  Si := BATN.First_Node (BATN.States (BA));
269
                  loop
270 1
                     N_Si := BATN.First_Node (BATN.Identifiers (Si));
271
                     loop
272 1
                        if Analyzer.AADL_BA.Is_Initial (BA, N_Si) then
273 1
                           Variable := Make_Var_Declaration (
274 1
                            Make_Identifier ("STATE"),
275 1
                            Make_Identifier ("LNT_Type_States"));
276 1
                           BLNu.Append_Node_To_List (Variable, Var_Dec);
277 1
                           BLNu.Append_Node_To_List (Make_Assignment_Statement
278 1
                             (Make_Identifier ("STATE"), Make_Identifier (
279 1
                             To_Upper (BATN.Display_Name (N_Si)))),
280
                               Out_Loop);
281
                        end if;
282 1
                        BLNu.Append_Node_To_List (Make_Identifier (
283 1
                          To_Upper (BATN.Display_Name (N_Si))),
284
                         LNT_States_List);
285 1
                        N_Si := BATN.Next_Node (N_Si);
286 1
                        exit when No (N_Si);
287 1
                     end loop;
288 1
                     Si := BATN.Next_Node (Si);
289 1
                     exit when No (Si);
290 1
                  end loop;
291
               end if;
292 1
               if not BANu.Is_Empty (BATN.Variables (BA)) then
293 0
                  Vi := BATN.First_Node (BATN.Variables (BA));
294
                  loop
295 0
                     N_Vi := BATN.First_Node (BATN.Identifiers (Vi));
296
                     loop
297 0
                        BLNu.Append_Node_To_List (Make_Identifier (
298 0
                          To_Upper (BATN.Display_Name (N_Vi))),
299
                         LNT_States_List);
300 0
                        N_Vi := BATN.Next_Node (N_Vi);
301 0
                        exit when No (N_Vi);
302 0
                     end loop;
303 0
                     Vi := BATN.Next_Node (Vi);
304 0
                     exit when No (Vi);
305 0
                  end loop;
306
               end if;
307 1
               if not BANu.Is_Empty (BATN.Transitions (BA)) then
308 1
                  Ti := BATN.First_Node (BATN.Transitions (BA));
309
                  loop
310 1
                     Ti := BATN.Transition (Ti);
311 1
                     Source_Transition_List := BATN.Sources (Ti);
312 1
                     Destination_Transition := BATN.Destination (Ti);
313
                     --  if (STATE == S1) and (not (INPUT))
314
                     --  then STATE := S1; ... end if;
315 1
                     Put_Line (Image (BATN.Display_Name
316
                     (Destination_Transition)));
317 1
                     Put_Line (Image (BATN.Display_Name
318 1
                     (BATN.First_Node (Source_Transition_List))));
319
                     --  --- ----- --- --- ---
320 1
                     Ti := BATN.Next_Node (Ti);
321 1
                     exit when No (Ti);
322 0
                  end loop;
323
               end if;
324
            end if;
325 1
            S := AIN.Next_Node (S);
326 1
            exit when No (S);
327 0
         end loop;
328
      end if;
329
      --  end BA mapping
330

331 1
      if not AINU.Is_Empty (Features (E)) then
332 1
         S := AIN.First_Node (Features (E));
333
         loop
334 1
            if (AIN.Kind (S) = K_Port_Spec_Instance) then
335
               --  gate identifier
336 1
               N_Port := New_Identifier (To_Upper (AIN.Name
337 1
                  (AIN.Identifier (S))), "PORT_");
338
               --  variable identifier
339 1
               N_Variable_Port := Make_Identifier (To_Upper (AIN.Name
340 1
                      (AIN.Identifier (S))));
341 1
               Aux_N_Variable_Port := BLNu.Make_Node_Container
342
                (N_Variable_Port);
343
               --  port variable
344 1
               Variable := Make_Var_Declaration (N_Variable_Port,
345 1
                    Make_Identifier ("LNT_Type_Data"));
346 1
               BLNu.Append_Node_To_List (Variable, Var_Dec);
347

348
               --  gate declaration
349 1
               Gate := Make_Gate_Declaration (
350 1
                  Make_Identifier ("LNT_Channel_Port"), N_Port);
351 1
               BLNu.Append_Node_To_List (Gate, L_Gates);
352
               --  gate communication
353 1
               if AIN.Is_Out (S) then
354
                  --  port variable initialization
355 1
                  if Has_BA then
356 1
                     BLNu.Append_Node_To_List (Make_Assignment_Statement
357 1
                     (Aux_N_Variable_Port, Make_Identifier ("NONE")),
358
                      Out_Loop);
359
                  else
360 1
                     BLNu.Append_Node_To_List (Make_Assignment_Statement
361 1
                     (Aux_N_Variable_Port, Make_Identifier ("AADLDATA")),
362
                      Out_Loop);
363
                  end if;
364 1
                  Communication := Make_Communication_Statement
365 1
                   (N_Port, New_List (Make_Offer_Statement
366
                       (No_Node, N_Variable_Port, false)));
367 1
                  Aux_Communication := BLNu.Make_Node_Container
368
                   (Communication);
369

370 1
                  BLNu.Append_Node_To_List (Communication, L_Out_Port);
371 1
                  BLNu.Append_Node_To_List (Aux_Communication, L_End);
372 1
               elsif AIN.Is_In (S) then
373
                  --  port variable initialization
374 1
                  if Has_BA then
375 1
                     BLNu.Append_Node_To_List (Make_Assignment_Statement
376 1
                     (Aux_N_Variable_Port, Make_Identifier ("NONE")),
377
                      Out_Loop);
378
                  else
379 1
                     BLNu.Append_Node_To_List (Make_Assignment_Statement
380 1
                     (Aux_N_Variable_Port, Make_Identifier ("EMPTY")),
381
                      Out_Loop);
382
                  end if;
383 1
                  Communication := Make_Communication_Statement
384 1
                   (N_Port, New_List (Make_Offer_Statement
385
                       (No_Node, N_Variable_Port, true)));
386 1
                  Aux_Communication := BLNu.Make_Node_Container
387
                   (Communication);
388

389 1
                  BLNu.Append_Node_To_List (Communication, L_In_Port);
390 1
                  BLNu.Append_Node_To_List (Aux_Communication, L_Begin);
391
               end if;
392
            end if;
393 1
            S := AIN.Next_Node (S);
394 1
            exit when No (S);
395 1
         end loop;
396
      end if;
397

398 1
      BLNu.Append_List_To_List (L_Out_Port, L_In_Port);
399

400 1
      BLNu.Append_List_To_List (L_In_Port, L_All);
401

402 1
      if (not BLNu.Is_Empty (L_Begin) or else
403 0
         not BLNu.Is_Empty (L_End) or else
404 0
         not BLNu.Is_Empty (L_All))
405
      then
406 1
         In_Select := New_List (
407 1
           Make_Select_Statement_Alternative (New_List (
408 1
           Make_Select_Statement (
409 1
           New_List (
410 1
            Make_Select_Statement_Alternative (L_Begin),
411 1
            Make_Select_Statement_Alternative (L_End),
412 1
            Make_Select_Statement_Alternative (L_All),
413 1
            Make_Select_Statement_Alternative (New_List (
414 1
             Make_Communication_Statement
415 1
              (N_Activation, New_List (Make_Identifier ("T_Preemption"))))))),
416 1
            Make_Communication_Statement
417 1
              (N_Activation, New_List (Make_Identifier ("T_Complete"))))),
418

419 1
            Make_Select_Statement_Alternative (New_List (
420 1
             Make_Communication_Statement
421 1
              (N_Activation, New_List (Make_Identifier ("T_Error"))))),
422 1
            Make_Select_Statement_Alternative (New_List (
423 1
             Make_Communication_Statement
424 1
              (N_Activation, New_List (Make_Identifier ("T_Stop"))))));
425 1
         L_Statements := BLNu.New_List (
426 1
             Make_Var_Loop_Select (
427
                 Var_Dec,
428
                 Out_Loop,
429
                 In_Select));
430
      else
431 0
         L_Statements := BLNu.New_List (Make_Null_Statement);
432
      end if;
433 1
      N := Make_Process_Definition
434 1
       (E, New_Identifier (Thread_Identifier, "Thread_"),
435
        No_List,
436
        L_Gates,
437
        No_List,
438
        No_List,
439
        L_Statements
440
        );
441 1
      BLNu.Append_Node_To_List (N, Definitions_List);
442

443 1
   end Visit_Thread_Instance;
444
   ----------------------------
445
   -- Visit_Device_Instance --
446
   ----------------------------
447 1
   procedure Visit_Device_Instance (E : Node_Id) is
448 1
      S : Node_Id;
449 1
      N : Node_Id;
450

451 1
      N_Port : Node_Id;
452 1
      Gate : Node_Id;
453 1
      Communication : Node_Id;
454 1
      L_Communications : List_Id;
455 1
      L_Gates : List_Id;
456 1
      L_Statements : List_Id;
457 1
      N_Loop : Node_Id;
458
      Device_Identifier : constant Name_Id
459 1
        := AIN.Display_Name (AIN.Identifier (E));
460
   begin
461

462
      --  Visit all the subcomponents of the thread
463 1
      if not AINU.Is_Empty (Subcomponents (E)) then
464 0
         S := AIN.First_Node (Subcomponents (E));
465 0
         while Present (S) loop
466 0
            Visit (Corresponding_Instance (S));
467 0
            S := AIN.Next_Node (S);
468 0
         end loop;
469
      end if;
470 1
      L_Gates := New_List;
471 1
      L_Communications := New_List;
472 1
      if not AINU.Is_Empty (Features (E)) then
473 1
         S := AIN.First_Node (Features (E));
474
         loop
475 1
            if (AIN.Kind (S) = K_Port_Spec_Instance) then
476 1
               N_Port := New_Identifier (To_Upper (AIN.Name
477 1
                  (AIN.Identifier (S))), "PORT_");
478

479 1
               Gate := Make_Gate_Declaration (
480 1
                  Make_Identifier ("LNT_Channel_Port"), N_Port);
481

482 1
               Communication := Make_Communication_Statement
483 1
                (N_Port, New_List (Make_Identifier ("AADLDATA")));
484

485 1
               BLNu.Append_Node_To_List (Make_Select_Statement_Alternative
486 1
                  (New_List (Communication)), L_Communications);
487 1
               BLNu.Append_Node_To_List (Gate, L_Gates);
488

489
            end if;
490
            --  Visit (Corresponding_Instance (S));
491 1
            S := AIN.Next_Node (S);
492 1
            exit when No (S);
493 1
         end loop;
494
      end if;
495 1
      if not BLNu.Is_Empty (L_Communications) then
496 1
         if (BLNu.Length (L_Communications) = 1) then
497 1
            BLNu.Append_Node_To_List (Make_Select_Statement_Alternative
498 1
                  (New_List (Make_Null_Statement)), L_Communications);
499
         end if;
500 1
         N_Loop := Make_Loop_Statement (
501 1
           New_List (Make_Select_Statement (L_Communications)));
502 1
         L_Statements := BLNu.New_List (N_Loop);
503
      else
504 1
         L_Statements := BLNu.New_List (Make_Null_Statement);
505
      end if;
506

507 1
      N := Make_Process_Definition
508 1
       (E, New_Identifier (Device_Identifier, "Device_"),
509
        No_List,
510
        L_Gates,
511
        No_List,
512
        No_List,
513
        L_Statements
514
        );
515 1
      BLNu.Append_Node_To_List (N, Definitions_List);
516

517 1
   end Visit_Device_Instance;
518
end Ocarina.Backends.LNT.Tree_Generator_Thread;

Read our documentation on viewing source code .

Loading