Commit 85296fb3 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Create data model for Concurrency view

parent b00557a6
......@@ -9,11 +9,12 @@ procedure AADL_Parser is
begin
declare
Model : constant TASTE_Model := Parse_Project;
dummy_Trans : constant TASTE_Model := Transform (Model);
Transformed : TASTE_Model := Transform (Model);
begin
Model.Dump;
Model.Generate_Build_Script;
Model.Generate_Code;
Create_Concurrency_View (Transformed);
Transformed.Dump;
Transformed.Generate_Build_Script;
Transformed.Generate_Code;
end;
exception
when TASTE.Quit_TASTE =>
......
......@@ -10,12 +10,13 @@ with Ada.Strings.Unbounded,
TASTE.Deployment_View,
TASTE.Concurrency_View,
TASTE.Data_View;
pragma Unreferenced (TASTE.Concurrency_View);
-- pragma Unreferenced (TASTE.Concurrency_View);
use Ada.Strings.Unbounded,
Ocarina.Types,
TASTE.Parser_Utils,
TASTE.Interface_View,
TASTE.Deployment_View,
TASTE.Concurrency_View,
TASTE.Data_View;
package TASTE.AADL_Parser is
......@@ -25,13 +26,15 @@ package TASTE.AADL_Parser is
type TASTE_Model is tagged
record
Interface_View : Complete_Interface_View;
Deployment_View : Complete_Deployment_View;
Data_View : Taste_Data_View;
Configuration : Taste_Configuration;
Interface_View : Complete_Interface_View;
Deployment_View : Complete_Deployment_View;
Data_View : Taste_Data_View;
Concurrency_View : Taste_Concurrency_View;
Configuration : Taste_Configuration;
end record;
function Parse_Project return TASTE_Model;
function Find_Binding (Model : TASTE_Model;
F : Unbounded_String)
return Option_Partition.Option;
......
......@@ -5,55 +5,64 @@
-- Model of the Concurrency View
with Ada.Containers.Indefinite_Ordered_Maps,
-- Ada.Containers.Indefinite_Vectors,
Ada.Strings.Unbounded,
-- Ada.Strings.Equal_Case_Insensitive,
-- Ada.Strings.Less_Case_Insensitive,
-- Text_IO,
-- Option_Type,
TASTE.Parser_Utils;
TASTE.Parser_Utils,
-- TASTE.AADL_Parser,
TASTE.Interface_View;
use Ada.Containers,
Ada.Strings.Unbounded,
-- Text_IO,
TASTE.Parser_Utils;
TASTE.Parser_Utils,
-- TASTE.AADL_Parser,
TASTE.Interface_View;
package TASTE.Concurrency_View is
-- use Option_UString;
-- use Option_ULL;
-- Exceptions specific to the Concurrency View
Concurrency_View_Error : exception;
type Port_Kind is (In_Port, Out_Port, In_Data, Out_Data);
type Protected_Block_PI is
record
Name : Unbounded_String;
PI : Taste_Interface;
Local_Caller : Boolean := True;
end record;
type Port (Kind : Port_Kind) is
package Protected_Block_PIs is new Indefinite_Ordered_Maps
(String, Protected_Block_PI);
type Protected_Block is
record
Name : Unbounded_String;
case Kind is
when In_Data | Out_Data =>
Sort : Unbounded_String;
when others =>
null;
end case;
Provided : Protected_Block_PIs.Map;
Required : Interfaces_Maps.Map;
Calling_Threads : String_Vectors.Vector;
end record;
package Protected_Blocks is new Indefinite_Ordered_Maps
(String, Protected_Block);
type Port is
record
Remote_Thread : Unbounded_String;
Remote_PI : Unbounded_String;
end record;
package Ports_Pkg is new Indefinite_Ordered_Maps (String, Port);
package Ports is new Indefinite_Ordered_Maps (String, Port);
type Process is
type AADL_Thread is
record
Name : Unbounded_String;
Ports : Ports_Pkg.Map;
Name : Unbounded_String;
Entry_Port_Name : Unbounded_String;
Protected_Block_Name : Unbounded_String;
Output_Ports : Ports.Map;
end record;
-- ASN1_File_Name : Optional_Unbounded_String := Nothing;
-- package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter);
-- Context : Unbounded_String := Null_Unbounded_String;
-- Key for the function map is case insensitive
-- package Option_Connection is new Option_Type (Connection);
-- subtype Optional_Connection is Option_Connection.Option;
package AADL_Threads is new Indefinite_Ordered_Maps (String, AADL_Thread);
-- procedure Debug_Dump (IV : Complete_Interface_View; Output : File_Type);
type Taste_Concurrency_View is
record
Threads : AADL_Threads.Map;
Blocks : Protected_Blocks.Map;
end record;
end TASTE.Concurrency_View;
......@@ -12,7 +12,6 @@ with Ada.Containers.Indefinite_Ordered_Maps,
Text_IO,
Ocarina,
Ocarina.Types,
-- Ocarina.Backends.Properties,
Option_Type,
TASTE.Parser_Utils;
......@@ -21,7 +20,6 @@ use Ada.Containers,
Text_IO,
Ocarina,
Ocarina.Types,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
package TASTE.Interface_View is
......
with Ada.Containers,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
TASTE.Parser_Utils,
TASTE.Concurrency_View;
use Ada.Containers,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
TASTE.Parser_Utils,
TASTE.Concurrency_View;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
-- with Text_IO; use Text_IO;
......@@ -14,8 +16,8 @@ package body TASTE.Model_Transformations is
return Function_Maps.Map
is
New_Functions : Function_Maps.Map;
Count_Active_PI : Natural := 0;
Count_Passive_PI : Natural := 0;
-- Count_Active_PI : Natural := 0;
-- Count_Passive_PI : Natural := 0;
begin
-- Look for GUIs and add a Poll PI (if there is at least one RI)
if F.Required.Length > 0 and F.Language = "gui" then
......@@ -30,82 +32,82 @@ package body TASTE.Model_Transformations is
-- Count the number of Active (Cyclic, Sporadic, Protected) and Passive
-- provided interfaces of a function ; this is needed for some model
-- transformations.
for PI of F.Provided loop
if PI.RCM = Unprotected_Operation then
Count_Passive_PI := Count_Passive_PI + 1;
else
Count_Active_PI := Count_Active_PI + 1;
end if;
end loop;
-- for PI of F.Provided loop
-- if PI.RCM = Unprotected_Operation then
-- Count_Passive_PI := Count_Passive_PI + 1;
-- else
-- Count_Active_PI := Count_Active_PI + 1;
-- end if;
-- end loop;
-- When a function contains several active interfaces, create a new
-- separate function for each of them; this is needed to keep the
-- system analyzable by having a 1-to-1 mapping between a function and
-- a thread.
for PI of F.Provided loop
if (PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation)
and then Count_Passive_PI + Count_Active_PI > 1
then
declare
New_F : Taste_Terminal_Function :=
(Name => F.Name & "_" & PI.Name,
Language => US ("blackbox_device"),
Context => F.Name,
Required => F.Required, -- Inherit from RIs
others => <>);
New_F_PI : Taste_Interface := PI;
New_F_RI : Taste_Interface := PI;
begin
New_F_PI.Parent_Function := New_F.Name;
-- Set the name of the RI of the newly created function
-- (avoid keeping the same name as the PI)
New_F_RI.Name := (if PI.RCM = Cyclic_Operation
then "CYC_" & PI.Name
else "SPO_" & PI.Name);
-- Connect the new function's RI to the PI of the old function
New_F_RI.Remote_Interfaces.Clear;
New_F_RI.Remote_Interfaces.Append
(Remote_Entity'(Function_Name => F.Name,
Interface_Name => PI.Name));
-- The Remote interface of the new PI are inherited from PI
-- NOTE: The remote interfaces of the callers of the PI will be
-- updated after the creation of all new functions, at model
-- level.
-- Change the nature of the PI that triggered a new function
-- (Unprotected if the function only contained one active PI,
-- and possibly any number of other unprotected PIs)
PI.RCM := (if Count_Active_PI > 1
then Protected_Operation
else Unprotected_Operation);
-- Replace the remotes of the PI with the new function
-- (They were copied to the PI of the new function)
PI.Remote_Interfaces.Clear;
PI.Remote_Interfaces.Append
(Remote_Entity'(Function_Name => New_F.Name,
Interface_Name => New_F_RI.Name));
-- Add the PI and RI to the new function
New_F.Provided.Insert (Key => To_String (PI.Name),
New_Item => New_F_PI);
New_F.Required.Insert (Key => To_String (New_F_RI.Name),
New_Item => New_F_RI);
-- Make sure the parent function of all RIs is set
for RI of New_F.Required loop
RI.Parent_Function := New_F.Name;
end loop;
-- Add to the list of newly created functions
New_Functions.Insert (Key => To_String (New_F.Name),
New_Item => New_F);
end;
end if;
end loop;
-- for PI of F.Provided loop
-- if (PI.RCM = Cyclic_Operation or PI.RCM = Sporadic_Operation)
-- and then Count_Passive_PI + Count_Active_PI > 1
-- then
-- declare
-- New_F : Taste_Terminal_Function :=
-- (Name => F.Name & "_" & PI.Name,
-- Language => US ("blackbox_device"),
-- Context => F.Name,
-- Required => F.Required, -- Inherit from RIs
-- others => <>);
-- New_F_PI : Taste_Interface := PI;
-- New_F_RI : Taste_Interface := PI;
-- begin
-- New_F_PI.Parent_Function := New_F.Name;
--
-- -- Set the name of the RI of the newly created function
-- -- (avoid keeping the same name as the PI)
-- New_F_RI.Name := (if PI.RCM = Cyclic_Operation
-- then "CYC_" & PI.Name
-- else "SPO_" & PI.Name);
--
-- -- Connect the new function's RI to the PI of the old function
-- New_F_RI.Remote_Interfaces.Clear;
-- New_F_RI.Remote_Interfaces.Append
-- (Remote_Entity'(Function_Name => F.Name,
-- Interface_Name => PI.Name));
-- -- The Remote interface of the new PI are inherited from PI
--
-- -- NOTE: The remote interfaces of the callers of the PI will be
-- -- updated after the creation of all new functions, at model
-- -- level.
--
-- -- Change the nature of the PI that triggered a new function
-- -- (Unprotected if the function only contained one active PI,
-- -- and possibly any number of other unprotected PIs)
-- PI.RCM := (if Count_Active_PI > 1
-- then Protected_Operation
-- else Unprotected_Operation);
--
-- -- Replace the remotes of the PI with the new function
-- -- (They were copied to the PI of the new function)
-- PI.Remote_Interfaces.Clear;
-- PI.Remote_Interfaces.Append
-- (Remote_Entity'(Function_Name => New_F.Name,
-- Interface_Name => New_F_RI.Name));
--
-- -- Add the PI and RI to the new function
-- New_F.Provided.Insert (Key => To_String (PI.Name),
-- New_Item => New_F_PI);
-- New_F.Required.Insert (Key => To_String (New_F_RI.Name),
-- New_Item => New_F_RI);
--
-- -- Make sure the parent function of all RIs is set
-- for RI of New_F.Required loop
-- RI.Parent_Function := New_F.Name;
-- end loop;
--
-- -- Add to the list of newly created functions
-- New_Functions.Insert (Key => To_String (New_F.Name),
-- New_Item => New_F);
-- end;
-- end if;
-- end loop;
return New_Functions;
end Process_Function;
......@@ -113,8 +115,8 @@ package body TASTE.Model_Transformations is
function Transform (Model : TASTE_Model) return TASTE_Model is
Result : TASTE_Model := Model;
New_Functions : Function_Maps.Map;
Functions : Function_Maps.Map
renames Result.Interface_View.Flat_Functions;
-- Functions : Function_Maps.Map
-- renames Result.Interface_View.Flat_Functions;
begin
-- Processing of user-defined functions (may return a list of new
-- functions that will be added to the model)
......@@ -133,72 +135,79 @@ package body TASTE.Model_Transformations is
-- For each PI and RI of newly-created function, look for all remote
-- functions, and find the corresponding PI or RI
-- Then replace the old remote function with the new one
for F of New_Functions loop
for PI of F.Provided loop
for Remote of PI.Remote_Interfaces loop
declare
Remote_Function : constant Function_Maps.Cursor :=
Functions.Find (To_String (Remote.Function_Name));
Corresponding_RI : constant Interfaces_Maps.Cursor :=
Functions (Remote_Function).Required.Find
(To_String (Remote.Interface_Name));
begin
for RI_Remote of Functions (Remote_Function).Required
(Corresponding_RI).Remote_Interfaces
loop
if RI_Remote.Function_Name = F.Context then
RI_Remote.Function_Name := F.Name;
end if;
end loop;
end;
end loop;
end loop;
for RI of F.Required loop
for Remote of RI.Remote_Interfaces loop
declare
Remote_Function : constant Function_Maps.Cursor :=
Functions.Find (To_String (Remote.Function_Name));
Corresponding_PI : constant Interfaces_Maps.Cursor :=
Functions (Remote_Function).Provided.Find
(To_String (Remote.Interface_Name));
begin
for PI_Remote of Functions (Remote_Function).Provided
(Corresponding_PI).Remote_Interfaces
loop
if PI_Remote.Function_Name = F.Context then
PI_Remote.Function_Name := F.Name;
end if;
end loop;
end;
end loop;
end loop;
-- Add the function to the deployment view
for Node of Result.Deployment_View.Nodes loop
for Partition of Node.Partitions loop
if Partition.Bound_Functions.Contains (To_String (F.Context))
then
begin
Partition.Bound_Functions.Insert (To_String (F.Name));
exception
when Constraint_Error =>
-- Insert error, value already exists in the set
Put_Error ("Vertical Transformation Error: generated "
& "name conflicts with user function "
& To_String (F.Name));
end;
end if;
end loop;
end loop;
-- Finally, add all newly-created functions to the new model
Result.Interface_View.Flat_Functions.Insert
(Key => To_String (F.Name),
New_Item => F);
end loop;
-- for F of New_Functions loop
-- for PI of F.Provided loop
-- for Remote of PI.Remote_Interfaces loop
-- declare
-- Remote_Function : constant Function_Maps.Cursor :=
-- Functions.Find (To_String (Remote.Function_Name));
-- Corresponding_RI : constant Interfaces_Maps.Cursor :=
-- Functions (Remote_Function).Required.Find
-- (To_String (Remote.Interface_Name));
-- begin
-- for RI_Remote of Functions (Remote_Function).Required
-- (Corresponding_RI).Remote_Interfaces
-- loop
-- if RI_Remote.Function_Name = F.Context then
-- RI_Remote.Function_Name := F.Name;
-- end if;
-- end loop;
-- end;
-- end loop;
-- end loop;
--
-- for RI of F.Required loop
-- for Remote of RI.Remote_Interfaces loop
-- declare
-- Remote_Function : constant Function_Maps.Cursor :=
-- Functions.Find (To_String (Remote.Function_Name));
-- Corresponding_PI : constant Interfaces_Maps.Cursor :=
-- Functions (Remote_Function).Provided.Find
-- (To_String (Remote.Interface_Name));
-- begin
-- for PI_Remote of Functions (Remote_Function).Provided
-- (Corresponding_PI).Remote_Interfaces
-- loop
-- if PI_Remote.Function_Name = F.Context then
-- PI_Remote.Function_Name := F.Name;
-- end if;
-- end loop;
-- end;
-- end loop;
--
-- end loop;
--
-- -- Add the function to the deployment view
-- for Node of Result.Deployment_View.Nodes loop
-- for Partition of Node.Partitions loop
-- if Partition.Bound_Functions.Contains (To_String (F.Context))
-- then
-- begin
-- Partition.Bound_Functions.Insert (To_String (F.Name));
-- exception
-- when Constraint_Error =>
-- -- Insert error, value already exists in the set
-- Put_Error ("Vertical Transformation Error: generated "
-- & "name conflicts with user function "
-- & To_String (F.Name));
-- end;
-- end if;
-- end loop;
-- end loop;
--
-- -- Finally, add all newly-created functions to the new model
-- Result.Interface_View.Flat_Functions.Insert
-- (Key => To_String (F.Name),
-- New_Item => F);
-- end loop;
return Result;
end Transform;
procedure Create_Concurrency_View (Model : in out TASTE_Model) is
Result : Taste_Concurrency_View;
begin
Model.Concurrency_View := Result;
end Create_Concurrency_View;
end TASTE.Model_Transformations;
......@@ -15,6 +15,9 @@ package TASTE.Model_Transformations is
-- * Create a Taste API per node
-- * Create Timer manager functions
function Transform (Model : TASTE_Model) return TASTE_Model;
procedure Create_Concurrency_View (Model : in out TASTE_Model);
Transformation_Error : exception;
private
......
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