Commit 42d26a97 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Parse interfaces to the new AST

parent fc727098
...@@ -345,7 +345,7 @@ procedure BuildSupport is ...@@ -345,7 +345,7 @@ procedure BuildSupport is
when Cyclic_Operation => when Cyclic_Operation =>
C_Set_Cyclic_IF; C_Set_Cyclic_IF;
when Sporadic_Operation => when Sporadic_Operation | Any_Operation =>
C_Set_Sporadic_IF; C_Set_Sporadic_IF;
when Protected_Operation => when Protected_Operation =>
......
...@@ -10,6 +10,7 @@ with Ada.Text_IO, ...@@ -10,6 +10,7 @@ with Ada.Text_IO,
Ocarina.Instances.Queries, Ocarina.Instances.Queries,
Ocarina.ME_AADL.AADL_Instances.Nutils, Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.ME_AADL.AADL_Instances.Entities, Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.Backends.Utils,
Ada.Characters.Latin_1; Ada.Characters.Latin_1;
package body Buildsupport_Utils is package body Buildsupport_Utils is
...@@ -20,7 +21,8 @@ package body Buildsupport_Utils is ...@@ -20,7 +21,8 @@ package body Buildsupport_Utils is
Ocarina.ME_AADL.AADL_Instances.Nutils, Ocarina.ME_AADL.AADL_Instances.Nutils,
Ada.Characters.Latin_1, Ada.Characters.Latin_1,
Ocarina.ME_AADL.AADL_Instances.Entities, Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL; Ocarina.ME_AADL,
Ocarina.Backends.Utils;
------------ ------------
-- Banner -- -- Banner --
...@@ -114,10 +116,11 @@ package body Buildsupport_Utils is ...@@ -114,10 +116,11 @@ package body Buildsupport_Utils is
Protected_Name : constant Name_Id := Get_String_Name ("protected"); Protected_Name : constant Name_Id := Get_String_Name ("protected");
Cyclic_Name : constant Name_Id := Get_String_Name ("cyclic"); Cyclic_Name : constant Name_Id := Get_String_Name ("cyclic");
Sporadic_Name : constant Name_Id := Get_String_Name ("sporadic"); Sporadic_Name : constant Name_Id := Get_String_Name ("sporadic");
Any_Name : constant Name_Id := Get_String_Name ("any");
begin begin
if Is_Defined_Enumeration_Property (E, RCM_Operation_Kind) then if Is_Defined_Enumeration_Property (E, RCM_Operation_Kind) then
RCM_Operation_Kind_N RCM_Operation_Kind_N :=
:= Get_Enumeration_Property (E, RCM_Operation_Kind); Get_Enumeration_Property (E, RCM_Operation_Kind);
if RCM_Operation_Kind_N = Unprotected_Name then if RCM_Operation_Kind_N = Unprotected_Name then
return Unprotected_Operation; return Unprotected_Operation;
...@@ -130,9 +133,13 @@ package body Buildsupport_Utils is ...@@ -130,9 +133,13 @@ package body Buildsupport_Utils is
elsif RCM_Operation_Kind_N = Sporadic_Name then elsif RCM_Operation_Kind_N = Sporadic_Name then
return Sporadic_Operation; return Sporadic_Operation;
elsif RCM_Operation_Kind_N = Any_Name then
return Any_Operation;
end if; end if;
end if; end if;
Exit_On_Error (True, "Could not determine interface kind"); Exit_On_Error (True, "Could not determine interface kind: "
& Get_Name_String (RCM_Operation_Kind_N));
return Sporadic_Operation; return Sporadic_Operation;
end Get_RCM_Operation_Kind; end Get_RCM_Operation_Kind;
...@@ -374,6 +381,20 @@ package body Buildsupport_Utils is ...@@ -374,6 +381,20 @@ package body Buildsupport_Utils is
return ASN1_Unknown; return ASN1_Unknown;
end Get_ASN1_Basic_Type; end Get_ASN1_Basic_Type;
----------------------------------------------------------------
-- Get Optional Worse Case Execution Time (Upper bound in ms) --
----------------------------------------------------------------
function Get_Upper_WCET (Func : Node_Id) return Optional_Long_Long is
(if Is_Subprogram_Access (Func) and then Sources (Func) /= No_List
and then AIN.First_Node (Sources (Func)) /= No_Node
and then Get_Execution_Time (Corresponding_Instance (AIN.Item
(AIN.First_Node (Sources (Func)))))
/= Empty_Time_Array
then Just (To_Milliseconds (Get_Execution_Time (Corresponding_Instance
(AIN.Item (AIN.First_Node (Sources (Func)))))(1)))
else Nothing);
--------------------------- ---------------------------
-- AST Builder Functions -- -- AST Builder Functions --
--------------------------- ---------------------------
...@@ -383,6 +404,7 @@ package body Buildsupport_Utils is ...@@ -383,6 +404,7 @@ package body Buildsupport_Utils is
use type Channels.Vector; use type Channels.Vector;
use type Ctxt_Params.Vector; use type Ctxt_Params.Vector;
use type Interfaces.Vector; use type Interfaces.Vector;
use type Parameters.Vector;
Funcs : Functions.Vector := Functions.Empty_Vector; Funcs : Functions.Vector := Functions.Empty_Vector;
Routes : Channels.Vector; -- := Channels.Empty_Vector; Routes : Channels.Vector; -- := Channels.Empty_Vector;
Current_Function : Node_Id; Current_Function : Node_Id;
...@@ -402,21 +424,46 @@ package body Buildsupport_Utils is ...@@ -402,21 +424,46 @@ package body Buildsupport_Utils is
else Nothing)); else Nothing));
end Parse_CP; end Parse_CP;
-- Parse a single parameter of an interface
-- * Name (Unbounded string)
-- * Sort (Unbounded string)
-- * ASN1_Module (Unbounded string)
-- * ASN1_Basic_Type (Supported_ASN1_Basic_Type)
-- * ASN1_File_Name (Unbounded string)
-- * Encoding (Supported_ASN1_Encoding)
-- * Direction (Parameter_Direction: IN or OUT)
function Parse_Parameter (Param_I : Node_Id) return ASN1_Parameter is
Asntype : constant Node_Id := Corresponding_Instance (Param_I);
begin
return (
Name => US (AIN_Case (Param_I)),
Sort => US (Get_Name_String (Get_Type_Source_Name (Asntype))),
ASN1_Module =>
US (Get_Name_String (Get_Ada_Package_Name (Asntype))),
ASN1_Basic_Type => Get_ASN1_Basic_Type (Asntype),
ASN1_File_Name =>
US (Get_Name_String (Get_Source_Text (Asntype)(1))),
Encoding => Get_ASN1_Encoding (Param_I),
Direction => (if AIN.Is_In (Param_I)
then param_in else param_out));
end Parse_Parameter;
-- Parse a function interface : -- Parse a function interface :
-- * Name (Unbounded string) -- * Name (Unbounded string)
-- * In_Parameters (Parameters.Vector) -- * Params (Parameters.Vector)
-- * Out_Parameters (Parameters.Vector) -- * RCM (Supported_RCM_Operation_Kind)
-- * RCM (Supported_RCM_Operation_Kind) -- * Period_Or_MIAT (Unsigned long long)
-- * Period_Or_MIAT (Natural) -- * WCET_ms (Optional unsigned long long)
-- * WCET (Natural) -- * Queue_Size (Optional unsigned long long)
-- * WCET unit (Unbounded string) -- * User_Properties (Property_Maps.Map)
-- * Queue_Size (Natural)
-- * User_Properties (Property_Maps.Map)
function Parse_Interface (If_I : Node_Id) return Taste_Interface is function Parse_Interface (If_I : Node_Id) return Taste_Interface is
Name : constant Name_Id := Get_Interface_Name (If_I); Name : constant Name_Id := Get_Interface_Name (If_I);
CI : constant Node_Id := Corresponding_Instance (If_I); CI : constant Node_Id := Corresponding_Instance (If_I);
Result : Taste_Interface; Result : Taste_Interface;
Sub_I : constant Node_Id := Get_RCM_Operation (If_I);
Param_I : Node_Id;
begin begin
pragma Assert (Present (Sub_I));
-- Keep compatibility with 1.2 models for the interface name -- Keep compatibility with 1.2 models for the interface name
Result.Name := (if Name = No_Name then US (AIN_Case (If_I)) else Result.Name := (if Name = No_Name then US (AIN_Case (If_I)) else
US (Get_Name_String (Name))); US (Get_Name_String (Name)));
...@@ -428,10 +475,19 @@ package body Buildsupport_Utils is ...@@ -428,10 +475,19 @@ package body Buildsupport_Utils is
else Nothing); else Nothing);
Result.RCM := Get_RCM_Operation_Kind (If_I); Result.RCM := Get_RCM_Operation_Kind (If_I);
Result.Period_Or_MIAT := Get_RCM_Period (If_I); Result.Period_Or_MIAT := Get_RCM_Period (If_I);
-- Still to do: WCET (& unit), and Parameters Result.WCET_ms := Get_Upper_WCET (If_I);
-- Parameters:
if not Is_Empty (AIN.Features (Sub_I)) then
Param_I := AIN.First_Node (AIN.Features (Sub_I));
while Present (Param_I) loop
if Kind (Param_I) = K_Parameter_Instance then
Result.Params := Result.Params & Parse_Parameter (Param_I);
end if;
Param_I := AIN.Next_Node (Param_I);
end loop;
end if;
return Result; return Result;
end Parse_Interface; end Parse_Interface;
pragma Unreferenced (Parse_Interface);
-- Parse the content of a single function : -- Parse the content of a single function :
-- * Name -- * Name
...@@ -479,10 +535,14 @@ package body Buildsupport_Utils is ...@@ -479,10 +535,14 @@ package body Buildsupport_Utils is
if Present (AIN.Features (Inst)) then if Present (AIN.Features (Inst)) then
PI_Or_RI := AIN.First_Node (AIN.Features (Inst)); PI_Or_RI := AIN.First_Node (AIN.Features (Inst));
while Present (PI_Or_RI) loop while Present (PI_Or_RI) loop
-- If_AST.RCM := Get_RCM_Operation_Kind (PI_Or_RI); if AIN.Is_Provided (PI_Or_RI) then
Result.Provided := Result.Provided
& Parse_Interface (PI_Or_RI);
else
Result.Required := Result.Required
& Parse_Interface (PI_Or_RI);
end if;
PI_Or_RI := AIN.Next_Node (PI_Or_RI); PI_Or_RI := AIN.Next_Node (PI_Or_RI);
-- PI or RI - test to be added:
-- Result.Provided := Result.Provided & If_AST;
end loop; end loop;
end if; end if;
......
...@@ -42,7 +42,8 @@ package Buildsupport_Utils is ...@@ -42,7 +42,8 @@ package Buildsupport_Utils is
type Supported_RCM_Operation_Kind is (Unprotected_Operation, type Supported_RCM_Operation_Kind is (Unprotected_Operation,
Protected_Operation, Protected_Operation,
Cyclic_Operation, Cyclic_Operation,
Sporadic_Operation); Sporadic_Operation,
Any_Operation);
function Get_RCM_Operation_Kind (E : Node_Id) function Get_RCM_Operation_Kind (E : Node_Id)
return Supported_RCM_Operation_Kind; return Supported_RCM_Operation_Kind;
...@@ -128,12 +129,10 @@ package Buildsupport_Utils is ...@@ -128,12 +129,10 @@ package Buildsupport_Utils is
type Taste_Interface is type Taste_Interface is
record record
Name : Unbounded_String; Name : Unbounded_String;
In_Parameters : Parameters.Vector; Params : Parameters.Vector;
Out_Parameters : Parameters.Vector;
RCM : Supported_RCM_Operation_Kind; RCM : Supported_RCM_Operation_Kind;
Period_Or_MIAT : Unsigned_Long_Long; Period_Or_MIAT : Unsigned_Long_Long;
WCET : Natural; WCET_ms : Optional_Long_Long;
WCET_Unit : Unbounded_String;
Queue_Size : Optional_Long_Long; Queue_Size : Optional_Long_Long;
User_Properties : Property_Maps.Map; User_Properties : Property_Maps.Map;
end record; end record;
......
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