Commit 3b470dad authored by jhugues's avatar jhugues
Browse files

* Update the AADL BA front end: all examples are now correctly

	 parsed, except arrays and arithmetic expressions.



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/ocarina@3586 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent 89c4cd44
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -299,6 +299,12 @@ package body Ocarina.BE_AADL_BA.Actions is ...@@ -299,6 +299,12 @@ package body Ocarina.BE_AADL_BA.Actions is
when CK_Exclamation => Print_Token (T_Exclamation); when CK_Exclamation => Print_Token (T_Exclamation);
when CK_Interrogative => Print_Token (T_Interrogative); when CK_Interrogative => Print_Token (T_Interrogative);
when CK_Greater_Greater => Print_Token (T_Greater_Greater_Than); when CK_Greater_Greater => Print_Token (T_Greater_Greater_Than);
when CK_Exclamation_Less_Than =>
Print_Token (T_Exclamation);
Print_Token (T_Less_Than_Sign);
when CK_Exclamation_Greater_Than =>
Print_Token (T_Exclamation);
Print_Token (T_Greater_Than_Sign);
when others => Write_Line (Bug_Str); when others => Write_Line (Bug_Str);
end case; end case;
end Print_Communication_Kind; end Print_Communication_Kind;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -62,7 +62,6 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is ...@@ -62,7 +62,6 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is
procedure Print_Dispatch_Condition (Node : Node_Id) is procedure Print_Dispatch_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Condition); pragma Assert (Kind (Node) = K_Dispatch_Condition);
pragma Assert (not Is_Empty (Dispatch_Logical_Expressions (Node)));
begin begin
Print_Tokens ((T_On, T_Dispatch)); Print_Tokens ((T_On, T_Dispatch));
...@@ -79,22 +78,23 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is ...@@ -79,22 +78,23 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is
---------------------------------------- ----------------------------------------
procedure Print_Dispatch_Logical_Expressions (List : List_Id) is procedure Print_Dispatch_Logical_Expressions (List : List_Id) is
pragma Assert (not Is_Empty (List));
List_Node : Node_Id; List_Node : Node_Id;
begin begin
List_Node := First_Node (List); if not Is_Empty (List) then
List_Node := First_Node (List);
while Present (List_Node) loop while Present (List_Node) loop
Print_Dispatch_Trigger (List_Node); Print_Dispatch_Trigger (List_Node);
List_Node := Next_Node (List_Node); List_Node := Next_Node (List_Node);
if Present (List_Node) then if Present (List_Node) then
Write_Space; Write_Space;
Print_Token (T_Or); Print_Token (T_Or);
Write_Space; Write_Space;
end if; end if;
end loop; end loop;
end if;
end Print_Dispatch_Logical_Expressions; end Print_Dispatch_Logical_Expressions;
---------------------------- ----------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2010, GET-Telecom Paris. -- -- Copyright (C) 2010-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -302,13 +302,14 @@ package body Ocarina.Builder.AADL_BA.Actions is ...@@ -302,13 +302,14 @@ package body Ocarina.Builder.AADL_BA.Actions is
Set_BE_Container (Fst_Behav_Time, Timed_Action); Set_BE_Container (Fst_Behav_Time, Timed_Action);
Set_Scd_Behavior_Time (Timed_Action, Scd_Behav_Time); Set_Scd_Behavior_Time (Timed_Action, Scd_Behav_Time);
Set_BE_Container (Scd_Behav_Time, Timed_Action); if Present (Scd_Behav_Time) then
Set_BE_Container (Scd_Behav_Time, Timed_Action);
end if;
Set_Distrib_Kind (Timed_Action, Distribution_Kind'Pos (Distribution)); Set_Distrib_Kind (Timed_Action, Distribution_Kind'Pos (Distribution));
Set_Is_Computation (Timed_Action, Is_Comput); Set_Is_Computation (Timed_Action, Is_Comput);
return Timed_Action; return Timed_Action;
end Add_New_Timed_Action; end Add_New_Timed_Action;
-------------------------------------- --------------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -394,7 +394,7 @@ package body Ocarina.Builder.AADL_BA.Expressions is ...@@ -394,7 +394,7 @@ package body Ocarina.Builder.AADL_BA.Expressions is
Set_Integer_Value (Behavior_Time, Integer_Val); Set_Integer_Value (Behavior_Time, Integer_Val);
Set_BE_Container (Integer_Val, Behavior_Time); Set_BE_Container (Integer_Val, Behavior_Time);
Set_Unit_Identifier (Behavior_Time, Integer_Val); Set_Unit_Identifier (Behavior_Time, Unit_Ident);
Set_BE_Container (Integer_Val, Behavior_Time); Set_BE_Container (Integer_Val, Behavior_Time);
return Behavior_Time; return Behavior_Time;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -58,7 +58,9 @@ package Ocarina.ME_AADL_BA is ...@@ -58,7 +58,9 @@ package Ocarina.ME_AADL_BA is
CK_No_Kind, CK_No_Kind,
CK_Exclamation, CK_Exclamation,
CK_Interrogative, CK_Interrogative,
CK_Greater_Greater); CK_Greater_Greater,
CK_Exclamation_Less_Than,
CK_Exclamation_Greater_Than);
-- Communication_Kind for Communication_Action Node -- Communication_Kind for Communication_Action Node
type Distribution_Kind is type Distribution_Kind is
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -568,14 +568,24 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is ...@@ -568,14 +568,24 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
return No_Node; return No_Node;
end if; end if;
elsif Token = T_Less_Than_Sign then
-- Parsed "!<"
Com_Kind := CK_Exclamation_Less_Than;
elsif Token = T_Greater_Than_Sign then
-- Parsed "!<"
Com_Kind := CK_Exclamation_Greater_Than;
else else
Restore_Lexer (Loc); Restore_Lexer (Loc);
end if; end if;
Save_Lexer (Loc); Save_Lexer (Loc);
Scan_Token; Scan_Token;
if Token = T_Right_Curly_Bracket then if Token = T_Right_Curly_Bracket then
Restore_Lexer (Loc); Restore_Lexer (Loc);
elsif Token /= T_Semicolon then elsif Token /= T_Semicolon then
DPE (PC_Assignment_Or_Communication_Action, DPE (PC_Assignment_Or_Communication_Action,
Expected_Token => T_Semicolon); Expected_Token => T_Semicolon);
...@@ -599,7 +609,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is ...@@ -599,7 +609,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
else else
return Node; return Node;
end if; end if;
end P_Assignment_Or_Communication_Action; end P_Assignment_Or_Communication_Action;
-------------------- --------------------
...@@ -668,10 +677,13 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is ...@@ -668,10 +677,13 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
case Token is case Token is
when T_Fixed => when T_Fixed =>
Distribution := DK_Fixed; Distribution := DK_Fixed;
when T_Normal => when T_Normal =>
Distribution := DK_Normal; Distribution := DK_Normal;
when T_Poisson => when T_Poisson =>
Distribution := DK_Poisson; Distribution := DK_Poisson;
when T_Random => when T_Random =>
Distribution := DK_Random; Distribution := DK_Random;
...@@ -689,8 +701,8 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is ...@@ -689,8 +701,8 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
end if; end if;
Scan_Token; Scan_Token;
if Token /= T_Right_Parenthesis then if Token /= T_Semicolon then
DPE (PC_Timed_Action, Expected_Token => T_Right_Parenthesis); DPE (PC_Timed_Action, Expected_Token => T_Semicolon);
Skip_Tokens (T_Semicolon); Skip_Tokens (T_Semicolon);
return No_Node; return No_Node;
end if; end if;
...@@ -707,7 +719,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is ...@@ -707,7 +719,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
else else
return Timed_Action; return Timed_Action;
end if; end if;
end P_Timed_Action; end P_Timed_Action;
-------------------------------- --------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -31,6 +31,8 @@ ...@@ -31,6 +31,8 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Text_IO;
with Locations; with Locations;
with Ocarina.FE_AADL_BA.Lexer; with Ocarina.FE_AADL_BA.Lexer;
...@@ -590,9 +592,10 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is ...@@ -590,9 +592,10 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
Behavior_Act_List := P_Behavior_Actions (Container); Behavior_Act_List := P_Behavior_Actions (Container);
if Is_Empty (Behavior_Act_List) then if Is_Empty (Behavior_Act_List) then
DPE (PC_Behavior_Transition, EMC_List_Is_Empty); -- DPE (PC_Behavior_Transition, EMC_List_Is_Empty);
Skip_Tokens (T_Semicolon); raise Program_Error;
return No_Node; -- Skip_Tokens (T_Semicolon);
-- return No_Node;
end if; end if;
Scan_Token; -- consume token } Scan_Token; -- consume token }
...@@ -601,7 +604,16 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is ...@@ -601,7 +604,16 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
end if; end if;
Scan_Token; Scan_Token;
if Token /= T_Semicolon then
if Token = T_Timeout then -- XXX
Scan_Token;
Ada.Text_IO.Put_Line (Token'Img);
Scan_Token;
Ada.Text_IO.Put_Line (Token'Img);
Scan_Token;
Ada.Text_IO.Put_Line (Token'Img);
elsif Token /= T_Semicolon then
DPE (PC_Behavior_Transition, DPE (PC_Behavior_Transition,
Expected_Token => T_Semicolon); Expected_Token => T_Semicolon);
Skip_Tokens (T_Semicolon); Skip_Tokens (T_Semicolon);
...@@ -622,7 +634,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is ...@@ -622,7 +634,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
else else
return Execute_Transition; return Execute_Transition;
end if; end if;
end P_Execute_Or_Mode_Behavior_Transition; end P_Execute_Or_Mode_Behavior_Transition;
-------------------------- --------------------------
...@@ -647,6 +658,7 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is ...@@ -647,6 +658,7 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
if Token = T_On then if Token = T_On then
Restore_Lexer (Start_Loc); Restore_Lexer (Start_Loc);
Condition_Node := P_Dispatch_Condition (No_Node); Condition_Node := P_Dispatch_Condition (No_Node);
else else
Restore_Lexer (Start_Loc); Restore_Lexer (Start_Loc);
Condition_Node := P_Value_Expression (No_Node); Condition_Node := P_Value_Expression (No_Node);
...@@ -667,7 +679,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is ...@@ -667,7 +679,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
else else
return Behavior_Condition; return Behavior_Condition;
end if; end if;
end P_Behavior_Condition; end P_Behavior_Condition;
end Ocarina.FE_AADL_BA.Parser.Specifications; end Ocarina.FE_AADL_BA.Parser.Specifications;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009-2012, European Space Agency (ESA). --
-- -- -- --
-- Ocarina is free software; you can redistribute it and/or modify -- -- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the -- -- it under terms of the GNU General Public License as published by the --
...@@ -57,21 +57,26 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -57,21 +57,26 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
function P_Dispatch_Trigger function P_Dispatch_Trigger
(Container : Types.Node_Id) (Container : Types.Node_Id)
return Node_Id; return Node_Id;
pragma Unreferenced (P_Dispatch_Trigger);
function P_Dispatch_Trigger_Conjunction function P_Dispatch_Trigger_Conjunction
(Container : Types.Node_Id; (Container : Types.Node_Id;
Start_Loc : Location) Start_Loc : Location)
return Node_Id; return Node_Id;
function P_Dispatch_Trigger_Condition
(Container : Types.Node_Id)
return Node_Id;
-------------------------- --------------------------
-- P_Dispatch_Condition -- -- P_Dispatch_Condition --
-------------------------- --------------------------
-- dispatch_condition ::= -- dispatch_condition ::=
-- on dispatch dispatch_logical_expression [ frozen frozen_ports ] -- on dispatch [ dispatch_trigger_condition ] [ frozen frozen_ports ]
-- dispatch_logical_expression ::= -- frozen_ports ::=
-- dispatch_trigger { or dispatch_trigger }* -- in_port_identifier { , in_port_identifier }*
function P_Dispatch_Condition (Container : Types.Node_Id) function P_Dispatch_Condition (Container : Types.Node_Id)
return Node_Id return Node_Id
...@@ -80,16 +85,17 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -80,16 +85,17 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
Loc : Location; Loc : Location;
Frozen_Port_List : List_Id := No_List; Frozen_Port_List : List_Id := No_List;
Dispatch_Logical_List : List_Id; Dispatch_Trigger_Conditions : List_Id;
Dispatch_Condition : Node_Id; Dispatch_Condition : Node_Id;
begin begin
Save_Lexer (Start_Loc); Save_Lexer (Start_Loc);
Scan_Token; -- consume T_On Scan_Token; -- consume T_On
Dispatch_Condition := Add_New_Dispatch_Condition (Start_Loc, Dispatch_Condition := Add_New_Dispatch_Condition
Container, (Loc => Start_Loc,
No_List, Container => Container,
No_List); Expressions => No_List,
Frozen_Port_List => No_List);
if No (Dispatch_Condition) then if No (Dispatch_Condition) then
DPE (PC_Dispatch_Condition, EMC_Failed); DPE (PC_Dispatch_Condition, EMC_Failed);
...@@ -97,31 +103,28 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -97,31 +103,28 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
return No_Node; return No_Node;
end if; end if;
-- Parse token "dispatch"
Scan_Token; Scan_Token;
if Token /= T_Dispatch then if Token /= T_Dispatch then
Restore_Lexer (Start_Loc); Restore_Lexer (Start_Loc);
DPE (PC_Dispatch_Condition, DPE (PC_Dispatch_Condition, Expected_Token => T_Dispatch);
Expected_Token => T_Dispatch);
Skip_Tokens (T_Semicolon); Skip_Tokens (T_Semicolon);
return No_Node; return No_Node;
end if; end if;
Dispatch_Logical_List := P_Items_List (P_Dispatch_Trigger'Access, -- Parse dispatch_trigger_condition
Dispatch_Condition,
T_Or);
if Is_Empty (Dispatch_Logical_List) then Dispatch_Trigger_Conditions := P_Items_List
DPE (PC_Dispatch_Condition, EMC_List_Is_Empty); (P_Dispatch_Trigger_Condition'Access, Dispatch_Condition, T_Or);
Skip_Tokens (T_Semicolon);
return No_Node; -- Parse list of frozen ports
end if;
Save_Lexer (Loc); Save_Lexer (Loc);
Scan_Token; Scan_Token;
if Token = T_Frozen then if Token = T_Frozen then
Frozen_Port_List := P_Items_List (P_Identifier'Access, Frozen_Port_List := P_Items_List
Dispatch_Condition, (P_Identifier'Access, Dispatch_Condition, T_Comma);
T_Comma);
if Is_Empty (Frozen_Port_List) then if Is_Empty (Frozen_Port_List) then
DPE (PC_Dispatch_Condition, EMC_List_Is_Empty); DPE (PC_Dispatch_Condition, EMC_List_Is_Empty);
...@@ -132,10 +135,11 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -132,10 +135,11 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
Restore_Lexer (Loc); Restore_Lexer (Loc);
end if; end if;
Add_New_Dispatch_Condition (Dispatch_Condition, Add_New_Dispatch_Condition
Container, (Dispatch_Condition,
Dispatch_Logical_List, Container,
Frozen_Port_List); Dispatch_Trigger_Conditions,
Frozen_Port_List);
return Dispatch_Condition; return Dispatch_Condition;
end P_Dispatch_Condition; end P_Dispatch_Condition;
...@@ -145,10 +149,8 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -145,10 +149,8 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
------------------------ ------------------------
-- dispatch_trigger ::= -- dispatch_trigger ::=
-- dispatch_trigger_conjunction -- in_event_port_identifier
-- | timeout [ behavior_time ] -- | in_event_data_port_identifier
-- | stop
-- | abort
function P_Dispatch_Trigger (Container : Types.Node_Id) function P_Dispatch_Trigger (Container : Types.Node_Id)
return Node_Id return Node_Id
...@@ -227,9 +229,126 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is ...@@ -227,9 +229,126 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
else else
return Dispatch_Trigger_Node; return Dispatch_Trigger_Node;
end if; end if;
end P_Dispatch_Trigger; end P_Dispatch_Trigger;
-----------------------------------
-- P_Dispatch_Trigger_Condition --
-----------------------------------