Commit 3b470dad authored by jhugues's avatar jhugues

* 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 @@
-- --
-- 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 --
-- 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
when CK_Exclamation => Print_Token (T_Exclamation);
when CK_Interrogative => Print_Token (T_Interrogative);
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);
end case;
end Print_Communication_Kind;
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
procedure Print_Dispatch_Condition (Node : Node_Id) is
pragma Assert (Kind (Node) = K_Dispatch_Condition);
pragma Assert (not Is_Empty (Dispatch_Logical_Expressions (Node)));
begin
Print_Tokens ((T_On, T_Dispatch));
......@@ -79,22 +78,23 @@ package body Ocarina.BE_AADL_BA.Thread_Dispatch is
----------------------------------------
procedure Print_Dispatch_Logical_Expressions (List : List_Id) is
pragma Assert (not Is_Empty (List));
List_Node : Node_Id;
begin
List_Node := First_Node (List);
if not Is_Empty (List) then
List_Node := First_Node (List);
while Present (List_Node) loop
Print_Dispatch_Trigger (List_Node);
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;
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;
----------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
Set_BE_Container (Fst_Behav_Time, Timed_Action);
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_Is_Computation (Timed_Action, Is_Comput);
return Timed_Action;
end Add_New_Timed_Action;
--------------------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
Set_Integer_Value (Behavior_Time, Integer_Val);
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);
return Behavior_Time;
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- it under terms of the GNU General Public License as published by the --
......@@ -58,7 +58,9 @@ package Ocarina.ME_AADL_BA is
CK_No_Kind,
CK_Exclamation,
CK_Interrogative,
CK_Greater_Greater);
CK_Greater_Greater,
CK_Exclamation_Less_Than,
CK_Exclamation_Greater_Than);
-- Communication_Kind for Communication_Action Node
type Distribution_Kind is
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
return No_Node;
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
Restore_Lexer (Loc);
end if;
Save_Lexer (Loc);
Scan_Token;
if Token = T_Right_Curly_Bracket then
Restore_Lexer (Loc);
elsif Token /= T_Semicolon then
DPE (PC_Assignment_Or_Communication_Action,
Expected_Token => T_Semicolon);
......@@ -599,7 +609,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
else
return Node;
end if;
end P_Assignment_Or_Communication_Action;
--------------------
......@@ -668,10 +677,13 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
case Token is
when T_Fixed =>
Distribution := DK_Fixed;
when T_Normal =>
Distribution := DK_Normal;
when T_Poisson =>
Distribution := DK_Poisson;
when T_Random =>
Distribution := DK_Random;
......@@ -689,8 +701,8 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
end if;
Scan_Token;
if Token /= T_Right_Parenthesis then
DPE (PC_Timed_Action, Expected_Token => T_Right_Parenthesis);
if Token /= T_Semicolon then
DPE (PC_Timed_Action, Expected_Token => T_Semicolon);
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
......@@ -707,7 +719,6 @@ package body Ocarina.FE_AADL_BA.Parser.Actions is
else
return Timed_Action;
end if;
end P_Timed_Action;
--------------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- it under terms of the GNU General Public License as published by the --
......@@ -31,6 +31,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
with Locations;
with Ocarina.FE_AADL_BA.Lexer;
......@@ -590,9 +592,10 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
Behavior_Act_List := P_Behavior_Actions (Container);
if Is_Empty (Behavior_Act_List) then
DPE (PC_Behavior_Transition, EMC_List_Is_Empty);
Skip_Tokens (T_Semicolon);
return No_Node;
-- DPE (PC_Behavior_Transition, EMC_List_Is_Empty);
raise Program_Error;
-- Skip_Tokens (T_Semicolon);
-- return No_Node;
end if;
Scan_Token; -- consume token }
......@@ -601,7 +604,16 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
end if;
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,
Expected_Token => T_Semicolon);
Skip_Tokens (T_Semicolon);
......@@ -622,7 +634,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
else
return Execute_Transition;
end if;
end P_Execute_Or_Mode_Behavior_Transition;
--------------------------
......@@ -647,6 +658,7 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
if Token = T_On then
Restore_Lexer (Start_Loc);
Condition_Node := P_Dispatch_Condition (No_Node);
else
Restore_Lexer (Start_Loc);
Condition_Node := P_Value_Expression (No_Node);
......@@ -667,7 +679,6 @@ package body Ocarina.FE_AADL_BA.Parser.Specifications is
else
return Behavior_Condition;
end if;
end P_Behavior_Condition;
end Ocarina.FE_AADL_BA.Parser.Specifications;
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
function P_Dispatch_Trigger
(Container : Types.Node_Id)
return Node_Id;
pragma Unreferenced (P_Dispatch_Trigger);
function P_Dispatch_Trigger_Conjunction
(Container : Types.Node_Id;
Start_Loc : Location)
return Node_Id;
function P_Dispatch_Trigger_Condition
(Container : Types.Node_Id)
return Node_Id;
--------------------------
-- P_Dispatch_Condition --
--------------------------
-- dispatch_condition ::=
-- on dispatch dispatch_logical_expression [ frozen frozen_ports ]
-- on dispatch [ dispatch_trigger_condition ] [ frozen frozen_ports ]
-- dispatch_logical_expression ::=
-- dispatch_trigger { or dispatch_trigger }*
-- frozen_ports ::=
-- in_port_identifier { , in_port_identifier }*
function P_Dispatch_Condition (Container : Types.Node_Id)
return Node_Id
......@@ -80,16 +85,17 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
Loc : Location;
Frozen_Port_List : List_Id := No_List;
Dispatch_Logical_List : List_Id;
Dispatch_Trigger_Conditions : List_Id;
Dispatch_Condition : Node_Id;
begin
Save_Lexer (Start_Loc);
Scan_Token; -- consume T_On
Dispatch_Condition := Add_New_Dispatch_Condition (Start_Loc,
Container,
No_List,
No_List);
Dispatch_Condition := Add_New_Dispatch_Condition
(Loc => Start_Loc,
Container => Container,
Expressions => No_List,
Frozen_Port_List => No_List);
if No (Dispatch_Condition) then
DPE (PC_Dispatch_Condition, EMC_Failed);
......@@ -97,31 +103,28 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
return No_Node;
end if;
-- Parse token "dispatch"
Scan_Token;
if Token /= T_Dispatch then
Restore_Lexer (Start_Loc);
DPE (PC_Dispatch_Condition,
Expected_Token => T_Dispatch);
DPE (PC_Dispatch_Condition, Expected_Token => T_Dispatch);
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
Dispatch_Logical_List := P_Items_List (P_Dispatch_Trigger'Access,
Dispatch_Condition,
T_Or);
-- Parse dispatch_trigger_condition
if Is_Empty (Dispatch_Logical_List) then
DPE (PC_Dispatch_Condition, EMC_List_Is_Empty);
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
Dispatch_Trigger_Conditions := P_Items_List
(P_Dispatch_Trigger_Condition'Access, Dispatch_Condition, T_Or);
-- Parse list of frozen ports
Save_Lexer (Loc);
Scan_Token;
if Token = T_Frozen then
Frozen_Port_List := P_Items_List (P_Identifier'Access,
Dispatch_Condition,
T_Comma);
Frozen_Port_List := P_Items_List
(P_Identifier'Access, Dispatch_Condition, T_Comma);
if Is_Empty (Frozen_Port_List) then
DPE (PC_Dispatch_Condition, EMC_List_Is_Empty);
......@@ -132,10 +135,11 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
Restore_Lexer (Loc);
end if;
Add_New_Dispatch_Condition (Dispatch_Condition,
Container,
Dispatch_Logical_List,
Frozen_Port_List);
Add_New_Dispatch_Condition
(Dispatch_Condition,
Container,
Dispatch_Trigger_Conditions,
Frozen_Port_List);
return Dispatch_Condition;
end P_Dispatch_Condition;
......@@ -145,10 +149,8 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
------------------------
-- dispatch_trigger ::=
-- dispatch_trigger_conjunction
-- | timeout [ behavior_time ]
-- | stop
-- | abort
-- in_event_port_identifier
-- | in_event_data_port_identifier
function P_Dispatch_Trigger (Container : Types.Node_Id)
return Node_Id
......@@ -227,9 +229,126 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
else
return Dispatch_Trigger_Node;
end if;
end P_Dispatch_Trigger;
-----------------------------------
-- P_Dispatch_Trigger_Condition --
-----------------------------------
-- dispatch_trigger_condition ::=
-- dispatch_trigger_logical_expression
-- | provides_subprogram_access_identifier
-- | stop
-- | completion_relative_timeout_condition_and_catch
-- | dispatch_relative_timeout_catch
-- dispatch_logical_expression ::=
-- dispatch_trigger { or dispatch_trigger }*
-- dispatch_trigger_logical_expression ::=
-- dispatch_conjunction { or dispatch_conjunction }*
-- dispatch_conjunction ::=
-- dispatch_trigger { and dispatch_trigger }*
-- completion_relative_timeout_condition_and_catch ::=
-- timeout behavior_time
-- dispatch_relative_timeout_catch ::=
-- timeout
function P_Dispatch_Trigger_Condition
(Container : Types.Node_Id)
return Node_Id
is
Start_Loc : Location;
Loc : Location;
Dispatch_Trigger_Node : Node_Id;
Behavior_Time : Node_Id := No_Node;
Trigger_Conjunction : Node_Id := No_Node;
Trig_Kind : Dispatch_Trigger_Kind;
begin
Save_Lexer (Start_Loc);
Scan_Token;
case Token is
when T_Timeout =>
-- Parse either token "timeout",
-- or token "timeout" + behavior_time
Trig_Kind := TRI_Timeout;
Save_Lexer (Loc);
Scan_Token;
if Token = T_Real_Literal
or else Token = T_Integer_Literal
then
Restore_Lexer (Loc);
Behavior_Time := P_Behavior_Time (No_Node);
if No (Behavior_Time) then
DPE (PC_Dispatch_Trigger, EMC_Failed);
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
else
Restore_Lexer (Loc);
end if;
when T_Stop =>
-- Parse "stop" token
Trig_Kind := TRI_Stop;
when T_Identifier
| T_Integer_Literal
| T_Real_Literal
| T_Left_Parenthesis =>
Trig_Kind := TRI_No_Kind;
Trigger_Conjunction := P_Dispatch_Trigger_Conjunction (No_Node,
Start_Loc);
if No (Trigger_Conjunction) then
DPE (PC_Dispatch_Trigger,
EMC_Trigger_Conjunction_Failed);
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
when others =>
if Token = T_Right_Step_Bracket then
-- There is no dispatch_trigger_condition attached,
-- simply return.
Restore_Lexer (Start_Loc);
return No_Node;
else
DPE (PC_Dispatch_Trigger,
Expected_Tokens => (T_Timeout, T_Stop,
T_Right_Step_Bracket, T_Identifier));
Skip_Tokens (T_Semicolon);
return No_Node;
end if;
end case;
Dispatch_Trigger_Node := Add_New_Dispatch_Trigger
(Start_Loc,
Container,
Trig_Kind,
Trigger_Conjunction,
Behavior_Time);
if No (Dispatch_Trigger_Node) then
DPE (PC_Dispatch_Trigger, EMC_Failed);
Skip_Tokens (T_Semicolon);
return No_Node;
else
return Dispatch_Trigger_Node;
end if;
end P_Dispatch_Trigger_Condition;
------------------------------------
-- P_Dispatch_Trigger_Conjunction --
------------------------------------
......@@ -363,7 +482,6 @@ package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
else
return Trigger_Conj;
end if;
end P_Dispatch_Trigger_Conjunction;
end Ocarina.FE_AADL_BA.Parser.Thread_Dispatch;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment