Commit 737bae87 authored by yoogx's avatar yoogx
Browse files

* Split PolyORB_HI_Generated.Activity in

          PolyORB_HI_Generated.Activity and PolyORB_HI_Generated.Job

          For openaadl/ocarina#221
parent d8f7fcca
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2018 ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2019 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -2816,160 +2816,6 @@ package body Ocarina.Backends.Ada_Tree.Nutils is
end case;
end Set_Homogeneous_Parent_Unit_Name;
----------------------
-- Set_Helpers_Body --
----------------------
procedure Set_Helpers_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Helpers_Package (X));
end Set_Helpers_Body;
----------------------
-- Set_Helpers_Spec --
----------------------
procedure Set_Helpers_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Helpers_Package (X));
end Set_Helpers_Spec;
-----------------------
-- Set_Servants_Body --
-----------------------
procedure Set_Servants_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Servants_Package (X));
end Set_Servants_Body;
-----------------------
-- Set_Servants_Spec --
-----------------------
procedure Set_Servants_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Servants_Package (X));
end Set_Servants_Spec;
--------------------
-- Set_Setup_Spec --
--------------------
procedure Set_Setup_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Setup_Package (X));
end Set_Setup_Spec;
--------------------
-- Set_Setup_Body --
--------------------
procedure Set_Setup_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Setup_Package (X));
end Set_Setup_Body;
-------------------------
-- Set_Namespaces_Spec --
-------------------------
procedure Set_Namespaces_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Namespaces_Package (X));
end Set_Namespaces_Spec;
-------------------------
-- Set_Namespaces_Body --
-------------------------
procedure Set_Namespaces_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Namespaces_Package (X));
end Set_Namespaces_Body;
-------------------------
-- Set_Parameters_Body --
-------------------------
procedure Set_Parameters_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Parameters_Package (X));
end Set_Parameters_Body;
-------------------------
-- Set_Parameters_Spec --
-------------------------
procedure Set_Parameters_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Parameters_Package (X));
end Set_Parameters_Spec;
---------------------------
-- Set_Obj_Adapters_Spec --
---------------------------
procedure Set_Obj_Adapters_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Obj_Adapters_Package (X));
end Set_Obj_Adapters_Spec;
-------------------
-- Set_Main_Body --
-------------------
......@@ -3054,6 +2900,34 @@ package body Ocarina.Backends.Ada_Tree.Nutils is
Package_Specification (Activity_Package (X));
end Set_Activity_Spec;
------------------
-- Set_Job_Body --
------------------
procedure Set_Job_Body (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Implementation (Job_Package (X));
end Set_Job_Body;
------------------
-- Set_Job_Spec --
------------------
procedure Set_Job_Spec (N : Node_Id := No_Node) is
X : Node_Id := N;
begin
if No (X) then
X := Table (Last).Current_Entity;
end if;
Table (Last).Current_Package :=
Package_Specification (Job_Package (X));
end Set_Job_Spec;
------------------------
-- Set_Transport_Body --
------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2018 ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2019 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -850,30 +850,10 @@ package Ocarina.Backends.Ada_Tree.Nutils is
-- * K_Designator : The parent unit name is a K_Designator and the
-- parent unit name of its defining identifier is also set up.
-- Units setters for the PolyORB-QoS Module
procedure Set_Main_Body (N : Node_Id := No_Node);
procedure Set_Helpers_Body (N : Node_Id := No_Node);
procedure Set_Helpers_Spec (N : Node_Id := No_Node);
procedure Set_Servants_Body (N : Node_Id := No_Node);
procedure Set_Servants_Spec (N : Node_Id := No_Node);
procedure Set_Parameters_Body (N : Node_Id := No_Node);
procedure Set_Parameters_Spec (N : Node_Id := No_Node);
procedure Set_Setup_Body (N : Node_Id := No_Node);
procedure Set_Setup_Spec (N : Node_Id := No_Node);
procedure Set_Namespaces_Body (N : Node_Id := No_Node);
procedure Set_Namespaces_Spec (N : Node_Id := No_Node);
procedure Set_Obj_Adapters_Spec (N : Node_Id := No_Node);
-- Units Setters for the PolyORB-HI module
procedure Set_Main_Spec (N : Node_Id := No_Node);
procedure Set_Main_Body (N : Node_Id := No_Node);
procedure Set_Marshallers_Spec (N : Node_Id := No_Node);
procedure Set_Marshallers_Body (N : Node_Id := No_Node);
......@@ -881,6 +861,9 @@ package Ocarina.Backends.Ada_Tree.Nutils is
procedure Set_Activity_Spec (N : Node_Id := No_Node);
procedure Set_Activity_Body (N : Node_Id := No_Node);
procedure Set_Job_Spec (N : Node_Id := No_Node);
procedure Set_Job_Body (N : Node_Id := No_Node);
procedure Set_Transport_Spec (N : Node_Id := No_Node);
procedure Set_Transport_Body (N : Node_Id := No_Node);
......
......@@ -343,24 +343,13 @@ module Ocarina::Backends::Ada_Tree::Nodes {
Node_Id Entity;
};
/* This is the root node of the packages generated specifically for
an PolyORB-QoS Distributed application */
interface QoS_Unit : API_Unit {
Node_Id Helpers_Package;
Node_Id Servants_Package;
Node_Id Parameters_Package;
Node_Id Obj_Adapters_Package;
Node_Id Setup_Package;
Node_Id Namespaces_Package;
};
/* This is the root node of the packages generated specifically for
an PolyORB-HI Distributed application */
interface HI_Unit : API_Unit {
Node_Id Marshallers_Package;
Node_Id Activity_Package;
Node_Id Job_Package;
Node_Id Subprograms_Package;
Node_Id Transport_Package;
Node_Id Types_Package;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2018 ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-2019 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -30,10 +30,8 @@
------------------------------------------------------------------------------
with Ocarina.Namet;
with Locations;
with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;
......@@ -50,7 +48,6 @@ with Ocarina.Backends.PO_HI_Ada.Runtime;
package body Ocarina.Backends.PO_HI_Ada.Activity is
use Ocarina.Namet;
use Locations;
use Ocarina.ME_AADL;
use Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.ME_AADL.AADL_Instances.Entities;
......@@ -64,7 +61,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
package AAN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
package AAU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
package ADN renames Ocarina.Backends.Ada_Tree.Nodes;
......@@ -452,37 +448,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
procedure Visit_Device_Instance (E : Node_Id);
procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
procedure Cyclic_Task_Instantiation_Formals
(E : Node_Id;
P_List : List_Id);
-- Appends the formal generic parameter association which are
-- common between periodic and sporadic tasks.
function Periodic_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a periodic task
function Sporadic_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a sporadic task
function Aperiodic_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for an aperiodic task
function Hybrid_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a hybrid task
function Background_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a background task
function Null_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a null task
function ISR_Task_Instantiation (E : Node_Id) return Node_Id;
-- Build a package instantiation for a background task
function Task_Job_Spec (E : Node_Id) return Node_Id;
-- Creates the parameterless subprogram specification that does
-- the thread's job.
procedure Runtime_Routine_Specs (E : Node_Id);
-- Creates the specs of all the routines provided by the runtime
-- to the user-code to manipulate thread interface.
......@@ -493,507 +458,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
function Make_Modes_Enumeration (E : Node_Id) return Node_Id;
-- Create the mode enumeration
---------------------------------------
-- Cyclic_Task_Instantiation_Formals --
---------------------------------------
procedure Cyclic_Task_Instantiation_Formals
(E : Node_Id;
P_List : List_Id)
is
N : Node_Id;
I : Unsigned_Long_Long;
T : Time_Type;
begin
-- The entity name
N :=
Make_Parameter_Association
(Selector_Name => Make_Defining_Identifier (PN (P_Entity)),
Actual_Parameter => Extract_Enumerator (E));
Append_Node_To_List (N, P_List);
if Get_Thread_Dispatch_Protocol (E) = Thread_Periodic
or else Get_Thread_Dispatch_Protocol (E) = Thread_Sporadic
or else Get_Thread_Dispatch_Protocol (E) = Thread_Hybrid
or else Get_Thread_Dispatch_Protocol (E) = Thread_ISR
then
-- The task period of minimal interarrival time
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Task_Period)),
Actual_Parameter => Map_Ada_Time (Get_Thread_Period (E)));
Append_Node_To_List (N, P_List);
-- The task deadline
N := Map_Ada_Time (Get_Thread_Deadline (E));
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Task_Deadline)),
Actual_Parameter => N);
Append_Node_To_List (N, P_List);
end if;
if Get_Thread_Dispatch_Protocol (E) = Thread_Periodic then
-- The dispatch offset
T := Get_Dispatch_Offset (E);
if T /= Null_Time then
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Dispatch_Offset)),
Actual_Parameter => Map_Ada_Time (T));
Append_Node_To_List (N, P_List);
end if;
end if;
-- The task priority, if the thread has no priority, we
-- assign a default one.
I := Get_Thread_Priority (E);
if I = 0 then
N := RE (RE_Default_Priority);
else
N := Map_Ada_Priority (I);
end if;
N :=
Make_Parameter_Association
(Selector_Name => Make_Defining_Identifier (PN (P_Task_Priority)),
Actual_Parameter => N);
Append_Node_To_List (N, P_List);
-- The task stack size, if the thread has no stack size, we
-- assign a default one.
I := To_Bytes (Get_Thread_Stack_Size (E));
if I = 0 then
-- The default stack size is 100 Kb
N := Make_Literal (New_Integer_Value (100_000, 1, 10));
else
N := Make_Literal (New_Integer_Value (I, 1, 10));
end if;
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Task_Stack_Size)),
Actual_Parameter => N);
Append_Node_To_List (N, P_List);
-- The task job
N :=
Make_Parameter_Association
(Selector_Name => Make_Defining_Identifier (PN (P_Job)),
Actual_Parameter => Map_Task_Job_Identifier (E));
Append_Node_To_List (N, P_List);
-- If an activate entrypoint has been specified for the
-- thread, add an additional parameter association
declare
Activate_Entrypoint : constant Name_Id :=
Get_Thread_Activate_Entrypoint (E);
begin
if Activate_Entrypoint /= No_Name then
-- We cannot use direcly the activate entrypoint
-- because the Activity spec must not depend on user
-- package specs (to avoid introducing elaboration
-- cycles). We use subprogram renaming as workaround.
N :=
Make_Subprogram_Specification
(Defining_Identifier => Map_Task_Init_Identifier (E),
Parameter_Profile => No_List,
Return_Type => No_Node);
Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Activate_Entrypoint)),
Actual_Parameter => Map_Task_Init_Identifier (E));
Append_Node_To_List (N, P_List);
end if;
end;
-- If a recover entrypoint has been specified for the
-- thread, add an additional parameter association
declare
Rec_Entrypoint : constant Name_Id :=
Get_Thread_Recover_Entrypoint (E);
begin
if Rec_Entrypoint /= No_Name then
-- We cannot use direcly the recover entrypoint
-- because the Activity spec must not depend on user
-- package specs (to avoid introducing elaboration
-- cycles). We use subprogram renaminng as workaround.
N :=
Make_Subprogram_Specification
(Defining_Identifier => Map_Task_Recover_Identifier (E),
Parameter_Profile => No_List,
Return_Type => No_Node);
Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (PN (P_Recover_Entrypoint)),
Actual_Parameter => Map_Task_Recover_Identifier (E));
Append_Node_To_List (N, P_List);
end if;
end;
end Cyclic_Task_Instantiation_Formals;
---------------------------------
-- Periodic_Task_Instantiation --
---------------------------------
function Periodic_Task_Instantiation (E : Node_Id) return Node_Id is
N : Node_Id;
Parameter_List : constant List_Id :=
New_List (ADN.K_Parameter_Profile);
begin
-- Build the common parameters
Cyclic_Task_Instantiation_Formals (E, Parameter_List);
-- Build the package instantiation
N :=
Make_Package_Instantiation
(Defining_Identifier => Map_Task_Identifier (E),
Generic_Package =>
RU (RU_PolyORB_HI_Periodic_Task, Elaborated => True),
Parameter_List => Parameter_List);
return N;
end Periodic_Task_Instantiation;
---------------------------------
-- Sporadic_Task_Instantiation --
---------------------------------
function Sporadic_Task_Instantiation (E : Node_Id) return Node_Id is
N : Node_Id;
Parameter_List : constant List_Id := New_List (ADN.K_List_Id);
begin
-- Port_Type
N :=
Make_Parameter_Association
(Selector_Name => Make_Defining_Identifier (TN (T_Port_Type)),
Actual_Parameter =>
Make_Defining_Identifier (Map_Port_Enumeration_Name (E)));
Append_Node_To_List (N, Parameter_List);
-- Raise an error if the thread does not have IN ports
if not Has_In_Ports (E) then
Display_Located_Error
(Loc (E),
"This sporadic thread does not have IN ports",
Fatal => True);
end if;
-- Raise an error if the thread does not have 'in event'
-- ports.
if not Has_In_Event_Ports (E) then
Display_Located_Error
(Loc (E),
"None of the IN ports of this sporadic thread is an event port",
Fatal => True);
end if;
-- Append the common parameters
Cyclic_Task_Instantiation_Formals (E, Parameter_List);
-- The blocking routine
N :=
Make_Parameter_Association
(Selector_Name =>
Make_Defining_Identifier (SN (S_Wait_For_Incoming_Events)),
Actual_Parameter =>
Make_Defining_Identifier (SN (S_Wait_For_Incoming_Events)));
Append_Node_To_List (N, Parameter_List);