Skip to content

GitLab

O
Ocarina
Commit ffe5d888 authored by Bechir Zalila's avatar Bechir Zalila
Browse files
Options

* (*aadl_ba*): Reimplementation of the behaviour_annex parser. 

	(By Yossra Rekik)
parent ac85d4f2
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 4386 additions and 2393 deletions
src/backends/ocarina-be_aadl_ba-actions.adb
View file @ ffe5d888
This diff is collapsed.
src/backends/ocarina-be_aadl_ba-actions.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,10 +31,10 @@
package Ocarina.BE_AADL_BA.Actions is
procedure Print_Behavior_Actions (List : List_Id);
procedure Print_Behavior_Action_Block (Node : Node_Id);
procedure Print_Data_Component_Reference (Node : Node_Id);
procedure Print_Id (Node : Node_Id);
procedure Print_Name (Node : Node_Id);
end Ocarina.BE_AADL_BA.Actions;
src/backends/ocarina-be_aadl_ba-expressions.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,12 +31,18 @@
package Ocarina.BE_AADL_BA.Expressions is
procedure Print_Value_Holder (Node : Node_Id);
procedure Print_Value_Expression (Node : Node_Id);
procedure Print_Property_Constant (Node : Node_Id);
procedure Print_Integer_Range (Node : Node_Id);
procedure Print_Integer_Value (Node : Node_Id);
procedure Print_Behavior_Time (Node : Node_Id);
procedure Print_Literal (Node : Node_Id);
procedure Print_Value_Variable (Node : Node_Id);
procedure Print_Value_Expression (Node : Node_Id);
procedure Print_Property_Constant (Node : Node_Id);
procedure Print_Property_Reference (Node : Node_Id);
procedure Print_Property_Name (Node : Node_Id);
procedure Print_Property_Field (Node : Node_Id);
procedure Print_Component_Element_Ref (Node : Node_Id);
procedure Print_Integer_Range (Node : Node_Id);
procedure Print_Integer_Value (Node : Node_Id);
procedure Print_Behavior_Time (Node : Node_Id);
procedure Print_Literal (Node : Node_Id);
procedure Print_Boolean_Literal (Node : Node_Id);
procedure Print_Operator (Node : Node_Id);
end Ocarina.BE_AADL_BA.Expressions;
src/backends/ocarina-be_aadl_ba-identifiers.adb
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -59,9 +59,8 @@ package body Ocarina.BE_AADL_BA.Identifiers is
---------------------------------
procedure Print_Identifier_With_Value (Node : Node_Id) is
pragma Assert
(Kind (Node) = K_Identifier
or else Kind (Node) = K_Identifier_With_Value);
pragma Assert (Kind (Node) = K_Identifier
or else Kind (Node) = K_Identifier_With_Value);
begin
Write_Name (Display_Name (Node));
......@@ -70,14 +69,13 @@ package body Ocarina.BE_AADL_BA.Identifiers is
if Present (Value_Constant (Node)) then
case Kind (Value_Constant (Node)) is
when K_Literal =>
Print_Literal (Value_Constant (Node));
when K_Property_Constant =>
Print_Property_Constant (Value_Constant (Node));
when K_Identifier =>
Print_Identifier (Value_Constant (Node));
when others =>
Write_Line (Bug_Str);
when K_Literal => Print_Literal
(Value_Constant (Node));
when K_Property_Constant => Print_Property_Constant
(Value_Constant (Node));
when K_Identifier => Print_Identifier
(Value_Constant (Node));
when others => Write_Line (Bug_Str);
end case;
elsif Is_Others (Node) then
......
src/backends/ocarina-be_aadl_ba-identifiers.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......
src/backends/ocarina-be_aadl_ba-specifications.adb
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -53,13 +53,18 @@ package body Ocarina.BE_AADL_BA.Specifications is
package BAN renames Ocarina.ME_AADL_BA.BA_Tree.Nodes;
procedure Print_Behavior_Variable (Node : Node_Id);
procedure Print_Behavior_State (Node : Node_Id);
procedure Print_Behavior_State_Kind (State_Kind : Byte);
procedure Print_Behavior_Transition (Node : Node_Id);
procedure Print_Behavior_Variable (Node : Node_Id);
procedure Print_Behavior_State (Node : Node_Id);
procedure Print_Behavior_State_Kind (State_Kind : Byte);
procedure Print_Behavior_Transition (Node : Node_Id);
procedure Print_Execution_Behavior_Transition (Node : Node_Id);
procedure Print_Mode_Transition (Node : Node_Id);
procedure Print_Behavior_Condition (Node : Node_Id);
procedure Print_Mode_Transition (Node : Node_Id);
procedure Print_Behavior_Condition (Node : Node_Id);
procedure Print_Execute_Condition (Node : Node_Id);
procedure Print_Mode_Condition (Node : Node_Id);
procedure Print_Trigger_Logical_Expression (Node : Node_Id);
procedure Print_Event_Trigger (Node : Node_Id);
procedure Print_Port_Component_Ref (Node : Node_Id);
--------------------------
-- Print_Behavior_Annex --
......@@ -200,23 +205,20 @@ package body Ocarina.BE_AADL_BA.Specifications is
procedure Print_Behavior_State_Kind (State_Kind : Byte) is
begin
case Behavior_State_Kind'Val (State_Kind) is
when BSK_Initial =>
Print_Token (T_Initial);
when BSK_Initial_Complete =>
Print_Tokens ((T_Initial, T_Complete));
when BSK_Initial_Complete_Final =>
Print_Tokens ((T_Initial, T_Complete, T_Final));
when BSK_Initial_Final =>
Print_Tokens ((T_Initial, T_Final));
when BSK_Complete =>
Print_Token (T_Complete);
when BSK_Complete_Final =>
Print_Tokens ((T_Complete, T_Final));
when BSK_Final =>
Print_Token (T_Final);
when others =>
Write_Line (Bug_Str);
when BSK_Initial => Print_Token (T_Initial);
when BSK_Initial_Complete => Print_Tokens ((T_Initial,
T_Complete));
when BSK_Initial_Complete_Final => Print_Tokens ((T_Initial,
T_Complete,
T_Final));
when BSK_Initial_Final => Print_Tokens ((T_Initial,
T_Final));
when BSK_Complete => Print_Token (T_Complete);
when BSK_Complete_Final => Print_Tokens ((T_Complete,
T_Final));
when BSK_Final => Print_Token (T_Final);
when others => Write_Line (Bug_Str);
end case;
end Print_Behavior_State_Kind;
......@@ -289,13 +291,17 @@ package body Ocarina.BE_AADL_BA.Specifications is
Write_Space;
Print_Identifier (Destination (Node));
if not Is_Empty (Behavior_Actions (Node)) then
Write_Space;
Print_Token (T_Left_Curly_Bracket);
Print_Behavior_Actions (Behavior_Actions (Node));
Write_Eol;
Write_Indentation (+4);
Print_Token (T_Right_Curly_Bracket);
-- if not Is_Empty (Behavior_Actions (Node)) then
-- Write_Space;
-- Print_Token (T_Left_Curly_Bracket);
-- Print_Behavior_Actions (Behavior_Actions (Node));
-- Write_Eol;
-- Write_Indentation (+4);
-- Print_Token (T_Right_Curly_Bracket);
-- end if;
if Present (Behavior_Action_Block (Node)) then
Print_Behavior_Action_Block (Behavior_Action_Block (Node));
end if;
Print_Token (T_Semicolon);
......@@ -322,18 +328,117 @@ package body Ocarina.BE_AADL_BA.Specifications is
pragma Assert (Kind (Node) = K_Behavior_Condition);
Cond_Node : constant Node_Id := Condition (Node);
-- Execution_condition node is logical_value_expression node
begin
case Kind (Cond_Node) is
when K_Value_Expression =>
Print_Value_Expression (Cond_Node);
when K_Dispatch_Condition =>
Print_Dispatch_Condition (Cond_Node);
when K_Dispatch_Condition_Thread =>
Print_Dispatch_Condition (Cond_Node);
when K_Execute_Condition => Print_Execute_Condition (Cond_Node);
when K_Mode_Condition => Print_Mode_Condition (Cond_Node);
when others =>
Write_Line (Bug_Str);
when others => Write_Line (Bug_Str);
end case;
end Print_Behavior_Condition;
------------------------------
-- Print_Execute_Condition --
------------------------------
procedure Print_Execute_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Execute_Condition);
-- Cond_Node : constant Node_Id := Condition (Node);
begin
if Present (Value_Expression (Node)) then
Print_Value_Expression (Value_Expression (Node));
end if;
if Is_Otherwise (Node) then
Print_Token (T_Otherwise);
end if;
end Print_Execute_Condition;
------------------------------
-- Print_Mode_Condition --
------------------------------
procedure Print_Mode_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Mode_Condition);
begin
Print_Token (T_On);
Write_Space;
Print_Trigger_Logical_Expression (Trigger_Logical_Expr (Node));
end Print_Mode_Condition;
--------------------------------------
-- Print_Trigger_Logical_Expression --
--------------------------------------
procedure Print_Trigger_Logical_Expression (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Trigger_Logical_Expression);
pragma Assert (not Is_Empty (Event_Triggers (Node)));
List_Node : Node_Id;
begin
List_Node := First_Node (Event_Triggers (Node));
Print_Event_Trigger (List_Node);
List_Node := Next_Node (List_Node);
while Present (List_Node) loop
Write_Space;
case Kind (List_Node) is
when K_Event_Trigger => Print_Event_Trigger (List_Node);
when K_Operator => Print_Operator (List_Node);
when others => Write_Line (Bug_Str);
end case;
List_Node := Next_Node (List_Node);
end loop;
end Print_Trigger_Logical_Expression;
-------------------------
-- Print_Event_Trigger --
-------------------------
procedure Print_Event_Trigger (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Event_Trigger);
begin
if Present (Trigger_Log_Expr (Node)) then
Write_Space;
Print_Token (T_Left_Parenthesis);
Print_Trigger_Logical_Expression (Trigger_Log_Expr (Node));
Print_Token (T_Right_Parenthesis);
end if;
if Present (Port_Component_Ref (Node)) then
Write_Space;
Print_Port_Component_Ref (Port_Component_Ref (Node));
end if;
end Print_Event_Trigger;
------------------------------
-- Print_Port_Component_Ref --
------------------------------
procedure Print_Port_Component_Ref (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Port_Component_Reference);
begin
if Present (Subcomponent_Name (Node)) then
Print_Identifier (Subcomponent_Name (Node));
end if;
if Present (Port_Idt (Node)) then
Print_Token (T_Dot);
Print_Identifier (Port_Idt (Node));
end if;
end Print_Port_Component_Ref;
end Ocarina.BE_AADL_BA.Specifications;
src/backends/ocarina-be_aadl_ba-specifications.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......
src/backends/ocarina-be_aadl_ba-thread_dispatch.adb
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -49,65 +49,42 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is
use Ocarina.BE_AADL_BA.Expressions;
procedure Print_Dispatch_Logical_Expressions (List : List_Id);
procedure Print_Dispatch_Trigger (Node : Node_Id);
procedure Print_Dispatch_Trigger_Kind (Trigger_Kind : Byte);
procedure Print_Dispatch_Trigger_Conjunction (Node : Node_Id);
procedure Print_Frozen_Ports (List : List_Id);
procedure Print_Dispatch_Trigger_Kind (Trigger_Kind : Byte);
procedure Print_Dispatch_Trigger_Condition (Node : Node_Id);
procedure Print_Dispatch_Conjunction (Node : Node_Id);
procedure Print_Frozen_Ports (List : List_Id);
------------------------------
-- Print_Dispatch_Condition --
------------------------------
procedure Print_Dispatch_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Condition);
pragma Assert (Kind (Node) = K_Dispatch_Condition_Thread);
begin
Print_Tokens ((T_On, T_Dispatch));
Print_Dispatch_Logical_Expressions (Dispatch_Logical_Expressions (Node));
Print_Dispatch_Trigger_Condition (Dispatch_Trigger_Condition (Node));
if not Is_Empty (Frozen_Ports (Node)) then
Write_Space;
Print_Token (T_Frozen);
Print_Frozen_Ports (Frozen_Ports (Node));
end if;
end Print_Dispatch_Condition;
----------------------------------------
-- Print_Dispatch_Logical_Expressions --
----------------------------------------
--------------------------------------
-- Print_Dispatch_Trigger_Condition --
--------------------------------------
procedure Print_Dispatch_Logical_Expressions (List : List_Id) is
List_Node : Node_Id;
procedure Print_Dispatch_Trigger_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Trigger_Condition);
begin
if not Is_Empty (List) then
List_Node := First_Node (List);
while Present (List_Node) loop
Print_Dispatch_Trigger (List_Node);
List_Node := Next_Node (List_Node);
if Present (List_Node) then
Write_Space;
Print_Token (T_Or);
Write_Space;
end if;
end loop;
end if;
end Print_Dispatch_Logical_Expressions;
----------------------------
-- Print_Dispatch_Trigger --
----------------------------
procedure Print_Dispatch_Trigger (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Trigger);
begin
if Present (Dispatch_Trigger_Conjunction (Node)) then
Print_Dispatch_Trigger_Conjunction
(Dispatch_Trigger_Conjunction (Node));
if not Is_Empty (Dispatch_Conjunction (Node)) then
Write_Space;
Print_Dispatch_Logical_Expressions (Dispatch_Conjunction (Node));
end if;
if Dispatch_Trigger_Kind'Val (Trigger_Kind (Node)) /= TRI_No_Kind then
Write_Space;
Print_Dispatch_Trigger_Kind (Trigger_Kind (Node));
......@@ -117,78 +94,66 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is
Write_Space;
Print_Behavior_Time (Behavior_Time (Node));
end if;
end Print_Dispatch_Trigger;
---------------------------------
-- Print_Dispatch_Trigger_Kind --
---------------------------------
procedure Print_Dispatch_Trigger_Kind (Trigger_Kind : Byte) is
begin
case Dispatch_Trigger_Kind'Val (Trigger_Kind) is
when TRI_Abort =>
Print_Token (T_Abort);
when TRI_Stop =>
Print_Token (T_Stop);
when TRI_Timeout =>
Print_Token (T_Timeout);
when others =>
Write_Line (Bug_Str);
end case;
end Print_Dispatch_Trigger_Kind;
end Print_Dispatch_Trigger_Condition;
----------------------------------------
-- Print_Dispatch_Trigger_Conjunction --
-- Print_Dispatch_Logical_Expressions --
----------------------------------------
procedure Print_Dispatch_Trigger_Conjunction (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Trigger_Conjunction);
procedure Print_Dispatch_Logical_Expressions (List : List_Id) is
pragma Assert (not Is_Empty (List));
Is_Numeral : Boolean := False;
List_Node : Node_Id;
List_Node : Node_Id;
begin
if Present (Numeral (Node)) then
Is_Numeral := True;
List_Node := First_Node (List);
Print_Integer_Value (Numeral (Node));
while Present (List_Node) loop
Print_Dispatch_Conjunction (List_Node);
if Is_Ormore (Node) then
Print_Token (T_Ormore);
elsif Is_Orless (Node) then
Print_Token (T_Orless);
List_Node := Next_Node (List_Node);
if Present (List_Node) then
Write_Space;
Print_Token (T_Or);
Write_Space;
end if;
end if;
if Present (Dispatch_Trigger_Event (Node)) then
Write_Space;
Print_Identifier_With_Value (Dispatch_Trigger_Event (Node));
end loop;
end Print_Dispatch_Logical_Expressions;
elsif not Is_Empty (Dispatch_Trigger_Events (Node)) then
Write_Space;
Print_Token (T_Left_Parenthesis);
--------------------------------
-- Print_Dispatch_Conjunction --
--------------------------------
List_Node := First_Node (Dispatch_Trigger_Events (Node));
Print_Identifier_With_Value (List_Node);
procedure Print_Dispatch_Conjunction (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Conjunction);
List_Node := Next_Node (List_Node);
while Present (List_Node) loop
-- fixme : todo print constant_value or others BA 2.9
List_Node : Node_Id;
begin
List_Node := First_Node (Dispatch_Triggers (Node));
if Is_Numeral then
Print_Token (T_Comma);
else
Print_Token (T_And);
end if;
while Present (List_Node) loop
Print_Identifier (List_Node);
List_Node := Next_Node (List_Node);
if Present (List_Node) then
Write_Space;
Print_Identifier (List_Node);
Print_Token (T_And);
Write_Space;
end if;
end loop;
end Print_Dispatch_Conjunction;
List_Node := Next_Node (List_Node);
end loop;
---------------------------------
-- Print_Dispatch_Trigger_Kind --
---------------------------------
Print_Token (T_Right_Parenthesis);
end if;
end Print_Dispatch_Trigger_Conjunction;
procedure Print_Dispatch_Trigger_Kind (Trigger_Kind : Byte) is
begin
case Dispatch_Trigger_Kind'Val (Trigger_Kind) is
when TRI_Stop => Print_Token (T_Stop);
when TRI_Timeout => Print_Token (T_Timeout);
when others => Write_Line (Bug_Str);
end case;
end Print_Dispatch_Trigger_Kind;
------------------------
-- Print_Frozen_Ports --
......
src/backends/ocarina-be_aadl_ba-thread_dispatch.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......
src/backends/ocarina-be_aadl_ba.adb
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -58,10 +58,9 @@ package body Ocarina.BE_AADL_BA is
procedure Init is
begin
Register_Backend
("behavior_specification",
Generate_Behavior_Spec'Access,
Behavior_PP);
Register_Backend ("behavior_specification",
Generate_Behavior_Spec'Access,
Behavior_PP);
end Init;
-------------------
......@@ -74,7 +73,7 @@ package body Ocarina.BE_AADL_BA is
begin
case Kind (Node) is
when K_Behavior_Annex =>
when K_Behavior_Annex =>
Print_Behavior_Annex (Node);
when others =>
......@@ -109,7 +108,9 @@ package body Ocarina.BE_AADL_BA is
-- Print_Token --
-----------------
procedure Print_Token (Token : Ocarina.ME_AADL_BA.Tokens.BA_Token_Type) is
procedure Print_Token
(Token : Ocarina.ME_AADL_BA.Tokens.BA_Token_Type)
is
begin
Write_Str (Image (Token));
end Print_Token;
......
src/backends/ocarina-be_aadl_ba.ads
View file @ ffe5d888
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --