Commit 50b726d2 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Add function to dump the interface view

parent e1e20ecd
......@@ -1433,8 +1433,9 @@ begin
-- & "::" & To_String (Each.Name));
-- end loop;
Debug_Dump_IV (AST);
Process_Interface_View (IV_Root);
-- (Root_System (Instantiate_Model (Root => Interface_Root)));
-- Now, we are done with the interface view. We now analyze the
-- deployment view.
......
......@@ -257,8 +257,9 @@ package body Parser_Utils is
-- Only support single-value properties for now
single_val := ATN.Single_Value (prop_value);
result.Insert (Key => AIN_Case (property),
New_Item =>
(case ATN.Kind (single_val) is
New_Item => (Name => US (AIN_Case (property)),
Value =>
US (case ATN.Kind (single_val) is
when ATN.K_Signed_AADLNumber =>
Ocarina.AADL_Values.Image
(ATN.Value (ATN.Number_Value (single_val))) &
......@@ -279,7 +280,7 @@ package body Parser_Utils is
when ATN.K_Number_Range_Term =>
"RANGE NOT SUPPORTED!",
when others => "ERROR! Unsupported kind: "
& ATN.Kind (single_val)'Img));
& ATN.Kind (single_val)'Img)));
end if;
property := AIN.Next_Node (property);
end loop;
......@@ -402,7 +403,6 @@ package body Parser_Utils is
-- use type Functions.Vector;
use type Channels.Vector;
use type Ctxt_Params.Vector;
use type Interfaces.Vector;
use type Parameters.Vector;
use type Connection_Maps.Map;
Functions : Function_Maps.Map;
......@@ -749,10 +749,8 @@ package body Parser_Utils is
Routes_Map.Insert (Key => "_Root",
New_Item => Parse_System_Connections (System));
Put_Line ("The parser found the following functions");
-- Resolve the PI-RI connections within the functions
for Each of Functions loop
Put_Line ("Function: " & To_String (Each.Name));
for RI of Each.Required loop
declare
use Remote_Entities;
......@@ -760,31 +758,139 @@ package body Parser_Utils is
Remote : constant Remote_Entity := Rec_Jump
(To_String (Each.Name),
To_String (RI.Name));
V1 : Remote_Entities.Vector := Empty_Vector;
V2 : Remote_Entities.Vector := Empty_Vector;
Corr : Taste_Terminal_Function;
PI : Taste_Interface;
begin
Put (" ... RI " & To_String (RI.Name) & " ---> ");
Put (To_String (Remote.Function_Name) & ".");
Put_Line (To_String (Remote.Interface_Name));
if Remote.Function_Name /= "Not found!" then
V1 := RI.Remote_Interfaces.Value_Or (V1);
V1.Append (Remote);
RI.Remote_Interfaces.Append (Remote);
Corr := Functions.Element (To_String (Remote.Function_Name));
PI := Corr.Provided.Element
(To_String (Remote.Interface_Name));
V2 := PI.Remote_Interfaces.Value_Or (V2);
V2.Append (Remote_Entity'(Function_Name => Each.Name,
PI.Remote_Interfaces.Append
(Remote_Entity'(Function_Name => Each.Name,
Interface_Name => RI.Name));
Corr.Provided.Replace
(Key => To_String (Remote.Interface_Name),
New_Item => PI);
end if;
end;
end loop;
end loop;
return IV_AST : constant Complete_Interface_View :=
(Flat_Functions => Functions);
(Flat_Functions => Functions);
end AADL_to_Ada_IV;
procedure Rename_Function (IV : in out Complete_Interface_View;
From, To : String)
is
FV : Taste_Terminal_Function :=
IV.Flat_Functions.Element (Key => From);
Remote_FV : Taste_Terminal_Function;
Remote_If : Taste_Interface;
begin
FV.Name := US (To);
for Each of FV.Provided loop
Each.Parent_Function := FV.Name;
-- Update the "Remote Function Name" of all connected interfaces
for Remote of Each.Remote_Interfaces loop
Remote_FV := IV.Flat_Functions.Element
(Key => To_String (Remote.Function_Name));
Remote_If := Remote_FV.Required.Element
(Key => To_String (Remote.Interface_Name));
for Entity of Remote_If.Remote_Interfaces loop
if Entity.Function_Name = US (From) then
Entity.Function_Name := FV.Name;
end if;
end loop;
end loop;
end loop;
for Each of FV.Required loop
Each.Parent_Function := FV.Name;
-- Update the "Remote Function Name" of all connected interfaces
for Remote of Each.Remote_Interfaces loop
Remote_FV := IV.Flat_Functions.Element
(Key => To_String (Remote.Function_Name));
Remote_If := Remote_FV.Provided.Element
(Key => To_String (Remote.Interface_Name));
for Entity of Remote_If.Remote_Interfaces loop
if Entity.Function_Name = US (From) then
Entity.Function_Name := FV.Name;
end if;
end loop;
end loop;
end loop;
IV.Flat_Functions.Delete (Key => From);
IV.Flat_Functions.Insert (Key => To,
New_Item => FV);
end Rename_Function;
procedure Debug_Dump_IV (IV : Complete_Interface_View) is
procedure Dump_Interface (Ind : String := " ";
I : Taste_Interface) is
begin
Put_Line (Ind & "Name: " & To_String (I.Name) & " - in FV: "
& To_String (I.Parent_Function));
Put_Line (Ind & " RCM Kind : " & I.RCM'Img);
Put_Line (Ind & " Period/MIAT : " & I.Period_Or_MIAT'Img);
Put_Line (Ind & " WCET (ms) : " & Value_Or (I.WCET_ms, 0)'Img);
Put_Line (Ind & " Queue Size : " & Value_Or (I.Queue_Size, 1)'Img);
Put_Line (Ind & " Parameters :");
for Each of I.Params loop
Put_Line (Ind & " Name : " & To_String (Each.Name));
Put_Line (Ind & " Type : " & To_String (Each.Sort));
Put_Line (Ind & " ASN.1 Module : "
& To_String (Each.ASN1_Module));
Put_Line (Ind & " ASN.1 File : "
& To_String (Each.ASN1_File_Name));
Put_Line (Ind & " Basic type : "
& Each.ASN1_Basic_Type'Img);
Put_Line (Ind & " Encoding : " & Each.Encoding'Img);
Put_Line (Ind & " Direction : " & Each.Direction'Img);
end loop;
Put_Line (Ind & " Connections :");
for Each of I.Remote_Interfaces loop
Put_Line (Ind & " Function " & To_String (Each.Function_Name)
& ", interface " & To_String (Each.Interface_Name));
end loop;
end Dump_Interface;
begin
for Each of IV.Flat_Functions loop
Put_Line ("Function " & To_String (Each.Name)
& " in context " & To_String (Each.Context));
Put_Line (" Full Prefix: " & To_String (Value_Or (Each.Full_Prefix,
US ("(none)"))));
Put_Line (" Language : " & Each.Language'Img);
Put_Line (" Zip file : " & To_String (Value_Or (Each.Zip_File,
US ("(none)"))));
Put_Line (" Cxtx Params:");
for CP of Each.Context_Params loop
Put_Line (" " & To_String (CP.Name) & ":"
& To_String (CP.Sort) & "- default: "
& To_String (CP.Default_Value) & " - asn1 module: "
& To_String (CP.ASN1_Module) & " - file:"
& To_String (Value_Or (CP.ASN1_File_Name,
US ("(none)"))));
end loop;
Put_Line (" User properties:");
for Ppty of Each.User_Properties loop
Put_Line (" " & To_String (Ppty.Name) & " = "
& To_String (Ppty.Value));
end loop;
Put_Line (" Timers:");
for Timer of Each.Timers loop
Put_Line (" " & Timer);
end loop;
Put_Line (" Provided interfaces:");
for PI of Each.Provided loop
Dump_Interface (I => PI);
end loop;
Put_Line (" Required interfaces:");
for RI of Each.Required loop
Dump_Interface (I => RI);
end loop;
end loop;
end Debug_Dump_IV;
end Parser_Utils;
......@@ -71,7 +71,14 @@ package Parser_Utils is
ASN1_String,
ASN1_Unknown);
package Property_Maps is new Indefinite_Ordered_Maps (String, String);
type User_Property is
record
Name : Unbounded_String;
Value : Unbounded_String;
end record;
package Property_Maps is new Indefinite_Ordered_Maps (String,
User_Property);
use Property_Maps;
package String_Vectors is new Indefinite_Vectors (Natural, String);
......@@ -135,15 +142,12 @@ package Parser_Utils is
end record;
package Remote_Entities is new Indefinite_Vectors (Natural, Remote_Entity);
package Option_Remote_Entities is new Option_Type (Remote_Entities.Vector);
subtype Optional_Remote_Entities is Option_Remote_Entities.Option;
use Option_Remote_Entities;
type Taste_Interface is
record
Name : Unbounded_String;
Parent_Function : Unbounded_String;
Remote_Interfaces : Optional_Remote_Entities := Nothing;
Remote_Interfaces : Remote_Entities.Vector;
Params : Parameters.Vector;
RCM : Supported_RCM_Operation_Kind;
Period_Or_MIAT : Unsigned_Long_Long;
......@@ -152,7 +156,6 @@ package Parser_Utils is
User_Properties : Property_Maps.Map;
end record;
package Interfaces is new Indefinite_Vectors (Natural, Taste_Interface);
package Interfaces_Maps is new Indefinite_Ordered_Maps (String,
Taste_Interface);
......@@ -202,7 +205,7 @@ package Parser_Utils is
Channels.Vector,
"=" => Channels."=");
type Complete_Interface_View is
type Complete_Interface_View is tagged
record
Flat_Functions : Function_Maps.Map;
end record;
......@@ -210,4 +213,10 @@ package Parser_Utils is
-- Function to build up the Ada AST by transforming the one from Ocarina
function AADL_to_Ada_IV (System : Node_Id) return Complete_Interface_View;
-- Model transformation API: Rename a function
procedure Rename_Function (IV : in out Complete_Interface_View;
From, To : String);
procedure Debug_Dump_IV (IV : Complete_Interface_View);
end Parser_Utils;
Supports Markdown
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