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

33
with Ocarina.Me_AADL_BA.BA_Tree.Nodes;
34
with Ocarina.Me_AADL_BA.BA_Tree.Nutils;
35

36
use Ocarina.Me_AADL_BA.BA_Tree.Nutils;
37
use Ocarina.Me_AADL_BA.BA_Tree.Nodes;
38

39
package body Ocarina.Builder.Aadl_Ba.Specifications is
40

41
   ----------------------------
42
   -- Add_New_Behavior_Annex --
43
   ----------------------------
44

45 1
   function Add_New_Behavior_Annex
46
     (Loc         : Location;
47
      Container   : Node_Id;
48
      Variables   : List_Id;
49
      States      : List_Id;
50
      Transitions : List_Id)
51
     return Node_Id
52
   is
53
      --  pragma Unreferenced (Container);
54
      --  fixme check Container
55

56 1
      Behavior_Annex : constant Node_Id := New_Node (K_Behavior_Annex, Loc);
57
   begin
58 1
      Add_New_Behavior_Annex (Behavior_Annex,
59
                              Container,
60
                              Variables,
61
                              States,
62
                              Transitions);
63

64 1
      if No (Behavior_Annex) then
65 0
         return No_Node;
66
      else
67 1
         return Behavior_Annex;
68
      end if;
69
   end Add_New_Behavior_Annex;
70

71
   ----------------------------
72
   -- Add_New_Behavior_Annex --
73
   ----------------------------
74

75 1
   procedure Add_New_Behavior_Annex
76
     (Behavior_Annex : Node_Id;
77
      Container      : Node_Id := No_Node;
78
      Variables      : List_Id := No_List;
79
      States         : List_Id := No_List;
80
      Transitions    : List_Id := No_List)
81
   is
82
      pragma Unreferenced (Container);
83
      pragma Assert (Kind (Behavior_Annex) = K_Behavior_Annex);
84
   begin
85 1
      if not Is_Empty (Variables) then
86 1
         Set_Variables (Behavior_Annex, Variables);
87
      end if;
88

89 1
      if not Is_Empty (States) then
90 1
         Set_States (Behavior_Annex, States);
91
      end if;
92

93 1
      if not Is_Empty (Transitions) then
94 1
         Set_Transitions (Behavior_Annex, Transitions);
95
      end if;
96 1
   end Add_New_Behavior_Annex;
97

98
   -------------------------------
99
   -- Add_New_Behavior_Variable --
100
   -------------------------------
101

102 1
   function Add_New_Behavior_Variable
103
     (Loc          : Location;
104
      Container    : Node_Id;
105
      Ident_List   : List_Id;
106
      Class_Ref    : Node_Id)
107
     return Node_Id
108
   is
109
      pragma Assert (Kind (Container) = K_Behavior_Annex);
110

111
      Behavior_Variable : constant Node_Id :=
112 1
        New_Node (K_Behavior_Variable, Loc);
113
   begin
114 1
      Add_New_Behavior_Variable (Behavior_Variable,
115
                                 Container,
116
                                 Ident_List,
117
                                 Class_Ref);
118

119 1
      if No (Behavior_Variable) then
120 0
         return No_Node;
121
      else
122 1
         return Behavior_Variable;
123
      end if;
124
   end Add_New_Behavior_Variable;
125

126
   -------------------------------
127
   -- Add_New_Behavior_Variable --
128
   -------------------------------
129

130 1
   procedure Add_New_Behavior_Variable
131
     (Behavior_Variable : Node_Id;
132
      Container         : Node_Id := No_Node;
133
      Ident_List        : List_Id;
134
      Class_Ref         : Node_Id := No_Node)
135
   is
136
      pragma Assert (Kind (Behavior_Variable) = K_Behavior_Variable);
137
   begin
138 1
      if Container /= No_Node then
139 1
         Set_BE_Container (Behavior_Variable, Container);
140
      end if;
141

142 1
      if not Is_Empty (Ident_List) then
143 1
         Set_Identifiers (Behavior_Variable, Ident_List);
144
      end if;
145

146 1
      if Class_Ref /= No_Node then
147 1
         Set_Classifier_Ref (Behavior_Variable, Class_Ref);
148
      end if;
149 1
   end Add_New_Behavior_Variable;
150

151
   ----------------------------
152
   -- Add_New_Behavior_State --
153
   ----------------------------
154

155 1
   function Add_New_Behavior_State
156
     (Loc         : Location;
157
      Container   : Node_Id;
158
      Ident_List  : List_Id;
159
      State_Kind  : Behavior_State_Kind)
160
     return Node_Id
161
   is
162
      pragma Assert (Kind (Container) = K_Behavior_Annex);
163

164 1
      Behavior_State : constant Node_Id := New_Node (K_Behavior_State, Loc);
165
   begin
166 1
      Add_New_Behavior_State (Behavior_State,
167
                              Container,
168
                              Ident_List,
169
                              State_Kind);
170

171 1
      if No (Behavior_State) then
172 0
         return No_Node;
173
      else
174 1
         return Behavior_State;
175
      end if;
176
   end Add_New_Behavior_State;
177

178
   ----------------------------
179
   -- Add_New_Behavior_State --
180
   ----------------------------
181

182 1
   procedure Add_New_Behavior_State
183
     (Behavior_State : Node_Id;
184
      Container      : Node_Id             := No_Node;
185
      Ident_List     : List_Id             := No_List;
186
      State_Kind     : Behavior_State_Kind := BSK_Error)
187
   is
188
      pragma Assert (Kind (Behavior_State) = K_Behavior_State);
189
   begin
190 1
      if Container /= No_Node then
191 1
         Set_BE_Container (Behavior_State, Container);
192
      end if;
193

194 1
      if not Is_Empty (Ident_List) then
195 1
         Set_Identifiers (Behavior_State, Ident_List);
196
      end if;
197

198 1
      Set_State_Kind (Behavior_State, Behavior_State_Kind'Pos (State_Kind));
199

200 1
   end Add_New_Behavior_State;
201

202
   ---------------------------------
203
   -- Add_New_Behavior_Transition --
204
   ---------------------------------
205

206 1
   function Add_New_Behavior_Transition
207
     (Loc             : Location;
208
      Container       : Node_Id;
209
      Transition_Node : Node_Id)
210
     return Node_Id
211
   is
212
      pragma Assert (Kind (Container) = K_Behavior_Annex);
213

214
      Behavior_Transition : constant Node_Id :=
215 1
        New_Node (K_Behavior_Transition, Loc);
216
   begin
217 1
      if Transition_Node /= No_Node then
218 1
         Set_Transition (Behavior_Transition, Transition_Node);
219 1
         Set_BE_Container (Transition_Node, Behavior_Transition);
220
      end if;
221

222 1
      if No (Behavior_Transition) then
223 0
         return No_Node;
224
      end if;
225

226 1
      return Behavior_Transition;
227
   end Add_New_Behavior_Transition;
228

229
   --------------------------------
230
   -- Add_New_Execute_Transition --
231
   --------------------------------
232

233 1
   function Add_New_Execute_Transition
234
     (Loc                 : Location;
235
      Container           : Node_Id;
236
      Transition_Idt      : Node_Id;
237
      Transition_Priority : Node_Id;
238
      Sources             : List_Id;
239
      Behavior_Condition  : Node_Id;
240
      Destination         : Node_Id;
241
      Behavior_Act_Block  : Node_Id)
242
     return Node_Id
243
   is
244
      --  pragma Assert (Kind (Container) = K_Behavior_Transition);
245

246
      Execute_Transition : constant Node_Id :=
247 1
        New_Node (K_Execution_Behavior_Transition, Loc);
248
   begin
249 1
      Add_New_Execute_Transition (Execute_Transition,
250
                                  Container,
251
                                  Transition_Idt,
252
                                  Transition_Priority,
253
                                  Sources,
254
                                  Behavior_Condition,
255
                                  Destination,
256
                                  Behavior_Act_Block);
257

258 1
      if No (Execute_Transition) then
259 0
         return No_Node;
260
      else
261 1
         return Execute_Transition;
262
      end if;
263
   end Add_New_Execute_Transition;
264

265
   ---------------------------------
266
   -- Add_New_Execute_Transition --
267
   ---------------------------------
268

269 1
   procedure Add_New_Execute_Transition
270
     (Execute_Transition  : Node_Id;
271
      Container           : Node_Id := No_Node;
272
      Transition_Idt      : Node_Id := No_Node;
273
      Transition_Priority : Node_Id := No_Node;
274
      Sources             : List_Id := No_List;
275
      Behavior_Condition  : Node_Id := No_Node;
276
      Destination         : Node_Id := No_Node;
277
      Behavior_Act_Block  : Node_Id := No_Node)
278
   is
279
      pragma Assert (Kind (Execute_Transition) =
280
                       K_Execution_Behavior_Transition);
281
   begin
282 1
      if Container /= No_Node then
283 0
         Set_BE_Container (Execute_Transition, Container);
284
      end if;
285

286 1
      if Transition_Idt /= No_Node then
287 1
         Set_Behavior_Transition_Idt (Execute_Transition, Transition_Idt);
288
      end if;
289

290 1
      if Transition_Priority /= No_Node then
291 0
         Set_Behavior_Transition_Priority (Execute_Transition,
292
                                           Transition_Priority);
293
      end if;
294

295 1
      if not Is_Empty (Sources) then
296 1
         Set_Sources (Execute_Transition, Sources);
297
      end if;
298

299 1
      if Behavior_Condition /= No_Node then
300 1
         Set_Behavior_Condition (Execute_Transition, Behavior_Condition);
301
      end if;
302

303 1
      if Destination /= No_Node then
304 1
         Set_Destination (Execute_Transition, Destination);
305
      end if;
306

307 1
      if Present (Behavior_Act_Block) then
308 1
         Set_Behavior_Action_Block (Execute_Transition, Behavior_Act_Block);
309
      end if;
310 1
   end Add_New_Execute_Transition;
311

312
   --------------------------------
313
   -- Add_New_Behavior_Condition --
314
   --------------------------------
315

316 1
   function Add_New_Behavior_Condition
317
     (Loc              : Location;
318
      Container        : Node_Id;
319
      Condition_Node   : Node_Id)
320
     return Node_Id
321
   is
322
      pragma Assert (No (Container)
323 0
                       or else Kind (Container) = K_Behavior_Transition);
324
      pragma Assert (Kind (Condition_Node) = K_Dispatch_Condition_Thread
325 1
             or else Kind (Condition_Node) = K_Execute_Condition
326 0
             or else Kind (Condition_Node) = K_Mode_Condition);
327

328 1
      Behavior_Condition : constant Node_Id := New_Node (K_Behavior_Condition,
329
                                                         Loc);
330
   begin
331 1
      if Present (Container) then
332 0
         Set_BE_Container (Behavior_Condition, Container);
333
      end if;
334

335 1
      if Condition_Node /= No_Node then
336 1
         Set_Condition (Behavior_Condition, Condition_Node);
337 1
         Set_BE_Container (Condition_Node, Behavior_Condition);
338
      end if;
339

340 1
      if No (Behavior_Condition) then
341 0
         return No_Node;
342
      end if;
343

344 1
      return Behavior_Condition;
345
   end Add_New_Behavior_Condition;
346

347
   --------------------------------
348
   -- Add_New_Execute_Condition --
349
   --------------------------------
350

351 1
   function Add_New_Execute_Condition
352
     (Loc               : Location;
353
      Container         : Node_Id;
354
      Value_Expr        : Node_Id;
355
      Is_Otherwise_Bool : Boolean)
356
     return Node_Id
357
   is
358
      pragma Assert (No (Container)
359 0
                       or else Kind (Container) = K_Behavior_Condition);
360
      --  pragma Assert (Kind (Value_Expr) = K_Value_Expression);
361

362 1
      Execute_Condition : constant Node_Id := New_Node (K_Execute_Condition,
363
                                                         Loc);
364
   begin
365 1
      if Value_Expr /= No_Node then
366 1
         Set_Value_Expression (Execute_Condition, Value_Expr);
367 1
         Set_BE_Container (Value_Expr, Execute_Condition);
368
      end if;
369 1
         Set_Is_Otherwise (Execute_Condition, Is_Otherwise_Bool);
370

371 1
      return Execute_Condition;
372
   end Add_New_Execute_Condition;
373

374
   --------------------------------
375
   -- Add_New_Mode_Condition --
376
   --------------------------------
377

378 0
   function Add_New_Mode_Condition
379
     (Loc                  : Location;
380
      Container            : Node_Id;
381
      Trigger_Logical_Expr : Node_Id)
382
     return Node_Id
383
   is
384 0
      pragma Assert (No (Container)
385 0
                       or else Kind (Container) = K_Behavior_Condition);
386 0
      pragma Assert (Kind (Trigger_Logical_Expr) =
387
                       K_Trigger_Logical_Expression);
388

389 0
      Mode_Condition : constant Node_Id := New_Node (K_Mode_Condition, Loc);
390
   begin
391 0
      Set_BE_Container (Mode_Condition, Container);
392 0
      if Present (Trigger_Logical_Expr) then
393 0
         Set_Trigger_Logical_Expr (Mode_Condition,
394
                                           Trigger_Logical_Expr);
395 0
         Set_BE_Container (Trigger_Logical_Expr, Mode_Condition);
396
      end if;
397 0
      if No (Mode_Condition) then
398 0
         return No_Node;
399
      end if;
400

401 0
      return Mode_Condition;
402
   end Add_New_Mode_Condition;
403

404
   ----------------------------------
405
   -- Add_New_Trigger_Logical_Expr --
406
   ----------------------------------
407

408 0
   function Add_New_Trigger_Logical_Expr
409
     (Loc                       : Location;
410
      Container                 : Node_Id;
411
      Trigger_Logical_Expr_List : List_Id)
412
     return Node_Id
413
   is
414 0
      pragma Assert (No (Container));
415 0
      pragma Assert (not Is_Empty (Trigger_Logical_Expr_List));
416

417 0
      Trigger_Logical_Expr : constant Node_Id := New_Node
418
                       (K_Trigger_Logical_Expression, Loc);
419 0
      List_Node  : Node_Id;
420
   begin
421 0
      if Present (Container) then
422 0
         Set_BE_Container (Trigger_Logical_Expr, Container);
423
      end if;
424

425 0
      Set_Event_Triggers (Trigger_Logical_Expr, Trigger_Logical_Expr_List);
426

427 0
      List_Node := First_Node (Event_Triggers (Trigger_Logical_Expr));
428 0
      while Present (List_Node) loop
429 0
         Set_BE_Container (List_Node, Trigger_Logical_Expr);
430

431 0
         List_Node := Next_Node (List_Node);
432 0
      end loop;
433

434 0
      return Trigger_Logical_Expr;
435

436
   end Add_New_Trigger_Logical_Expr;
437

438
   ---------------------------
439
   -- Add_New_Event_Trigger --
440
   ---------------------------
441

442 0
   function Add_New_Event_Trigger
443
     (Loc                  : Location;
444
      Container            : Node_Id;
445
      Port_Component_Ref   : Node_Id;
446
      Trigger_Logical_Expr : Node_Id)
447
     return Node_Id
448
   is
449 0
      pragma Assert (No (Container));
450

451 0
      Event_Trigger : constant Node_Id := New_Node
452
                                    (K_Event_Trigger, Loc);
453
   begin
454 0
      if Present (Container) then
455 0
         Set_BE_Container (Event_Trigger, Container);
456
      end if;
457 0
      if Present (Trigger_Logical_Expr) then
458 0
         Set_Trigger_Log_Expr (Event_Trigger,
459
                                           Trigger_Logical_Expr);
460 0
         Set_BE_Container (Trigger_Logical_Expr, Event_Trigger);
461
      end if;
462 0
      if Present (Port_Component_Ref) then
463 0
         Set_Port_Component_Ref (Event_Trigger, Port_Component_Ref);
464 0
         Set_BE_Container (Port_Component_Ref, Event_Trigger);
465
      end if;
466 0
      if No (Event_Trigger) then
467 0
         return No_Node;
468
      end if;
469

470 0
      return Event_Trigger;
471
   end Add_New_Event_Trigger;
472

473
   --------------------------------------
474
   -- Add_New_Port_Component_Reference --
475
   --------------------------------------
476

477 0
   function Add_New_Port_Component_Reference
478
     (Loc               : Location;
479
      Container         : Node_Id;
480
      Subcomponent_Name : Node_Id;
481
      Port_Identifier   : Node_Id)
482
     return Node_Id
483
    is
484 0
      pragma Assert (No (Container));
485 0
      pragma Assert (Kind (Subcomponent_Name) = K_Identifier);
486 0
      pragma Assert (Kind (Port_Identifier) = K_Identifier);
487

488 0
      Port_Component_Ref : constant Node_Id := New_Node
489
                                    (K_Port_Component_Reference, Loc);
490
   begin
491 0
      Set_BE_Container (Port_Component_Ref, Container);
492 0
      if Present (Subcomponent_Name) then
493 0
         Set_Subcomponent_Name (Port_Component_Ref,
494
                                           Subcomponent_Name);
495 0
         Set_BE_Container (Subcomponent_Name, Port_Component_Ref);
496
      end if;
497 0
      if Present (Port_Identifier) then
498 0
         Set_Port_Idt (Port_Component_Ref, Port_Identifier);
499 0
         Set_BE_Container (Port_Identifier, Port_Component_Ref);
500
      end if;
501 0
      if No (Port_Component_Ref) then
502 0
         return No_Node;
503
      end if;
504

505 0
      return Port_Component_Ref;
506
   end Add_New_Port_Component_Reference;
507

508
end Ocarina.Builder.Aadl_Ba.Specifications;

Read our documentation on viewing source code .

Loading