Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
Ocarina
Commits
e5f84c63
Commit
e5f84c63
authored
Dec 12, 2014
by
yoogx
Browse files
Merge branch 'spark2014'
parents
8ce3ebb7
2b46fc52
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/backends/ocarina-backends-po_hi_ada-activity.adb
View file @
e5f84c63
...
...
@@ -413,6 +413,9 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
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
...
...
@@ -759,6 +762,27 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
return
N
;
end
Background_Task_Instantiation
;
-----------------------------
-- Null_Task_Instantiation --
-----------------------------
function
Null_Task_Instantiation
(
E
:
Node_Id
)
return
Node_Id
is
N
:
Node_Id
;
Parameter_List
:
constant
List_Id
:=
New_List
(
ADN
.
K_List_Id
);
begin
-- Append 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_Null_Task
),
Parameter_List
=>
Parameter_List
);
return
N
;
end
Null_Task_Instantiation
;
----------------------------
-- ISR_Task_Instantiation --
----------------------------
...
...
@@ -1037,15 +1061,20 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Fatal
=>
False
,
Warning
=>
True
);
elsif
Scheduling_Protocol
/=
POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL
elsif
Scheduling_Protocol
/=
POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL
and
then
Scheduling_Protocol
/=
ROUND_ROBIN_PROTOCOL
then
Display_Located_Error
(
Loc
(
Parent_Subcomponent
(
E
)),
"Incompatible scheduling protocol, "
&
"PolyORB-HI/Ada runtime assume "
&
"POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL"
,
Fatal
=>
False
);
"Incompatible scheduling protocol, "
&
"PolyORB-HI/Ada runtime requires "
&
"POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL or"
&
" ROUND_ROBIN_PROTOCOL"
,
Fatal
=>
True
);
-- XXX In case of Round robin, we should also check that
-- the scheduler is set to non-preemptive mode.
end
if
;
-- Visit all the subcomponents of the process
...
...
@@ -1159,6 +1188,13 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
S
:
constant
Node_Id
:=
Parent_Subcomponent
(
E
);
N
:
Node_Id
;
O
:
Node_Id
;
Scheduling_Protocol
:
constant
Supported_Scheduling_Protocol
:=
Get_Scheduling_Protocol
(
Get_Bound_Processor
(
Corresponding_Instance
(
Get_Container_Process
(
Parent_Subcomponent
(
E
)))));
begin
if
Has_Ports
(
E
)
then
-- The data types and the interrogation routines
...
...
@@ -1247,6 +1283,41 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
case
P
is
when
Thread_Periodic
=>
<<<<<<<
HEAD
N
:=
Message_Comment
(
"Periodic task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Sporadic
=>
N
:=
Message_Comment
(
"Sporadic task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Hybrid
=>
N
:=
Message_Comment
(
"Hybrid task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Aperiodic
=>
N
:=
Message_Comment
(
"Aperiodic task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Background
=>
N
:=
Message_Comment
(
"Background task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_ISR
=>
N
:=
Message_Comment
(
"ISR task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
=======
N
:=
Message_Comment
(
"Periodic task : "
&
...
...
@@ -1286,6 +1357,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Message_Comment
(
"ISR task : "
&
Get_Name_String
(
Display_Name
(
Identifier
(
S
))));
>>>>>>>
master
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
others
=>
...
...
@@ -1302,48 +1374,69 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
Bind_AADL_To_Job
(
Identifier
(
S
),
N
);
-- For each
periodic
thread, we instantiate a task.
-- For each
AADL
thread, we instantiate a task.
<<<<<<<
HEAD
if
Scheduling_Protocol
=
POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL
then
case
P
is
when
Thread_Periodic
=>
-- Instantiate the periodic task
=======
case
P
is
when
Thread_Periodic
=>
-- Instantiate the periodic task
>>>>>>>
master
N
:=
Periodic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
Periodic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Sporadic
=>
-- Instantiate the sporadic task
when
Thread_Sporadic
=>
-- Instantiate the sporadic task
N
:=
Sporadic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
Sporadic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Hybrid
=>
-- Instantiate the hybrid task
when
Thread_Hybrid
=>
-- Instantiate the hybrid task
N
:=
Hybrid_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
Hybrid_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_Aperiodic
=>
-- Instantiate the aperiodic task
when
Thread_Aperiodic
=>
-- Instantiate the aperiodic task
N
:=
Aperiodic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
Aperiodic_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
<<<<<<<
HEAD
when
Thread_Background
=>
-- Instantiate the background task
=======
when
Thread_Background
=>
-- Instantiate the background task
>>>>>>>
master
N
:=
Background_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
Background_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
Thread_ISR
=>
-- Instantiate the ISR task
when
Thread_ISR
=>
-- Instantiate the ISR task
N
:=
ISR_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
N
:=
ISR_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
when
others
=>
raise
Program_Error
;
end
case
;
when
others
=>
raise
Program_Error
;
end
case
;
elsif
Scheduling_Protocol
=
ROUND_ROBIN_PROTOCOL
then
N
:=
Null_Task_Instantiation
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
else
raise
Program_Error
;
end
if
;
if
Has_Modes
(
E
)
then
-- If the thread has operational modes, then generate the
...
...
@@ -1354,7 +1447,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
if
Is_Fusioned
(
E
)
then
N
:=
Make_Mode_Updater_Spec
(
E
);
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
end
if
;
...
...
@@ -1367,6 +1459,14 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
while
Present
(
O
)
loop
if
AINU
.
Is_Data
(
Corresponding_Instance
(
O
))
then
<<<<<<<
HEAD
N
:=
Make_Object_Declaration
(
Defining_Identifier
=>
Map_Ada_Defining_Identifier
(
O
),
Object_Definition
=>
Map_Ada_Data_Type_Designator
(
Corresponding_Instance
(
O
)));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
=======
N
:=
Make_Object_Declaration
(
Defining_Identifier
=>
Map_Ada_Defining_Identifier
(
O
),
...
...
@@ -1374,6 +1474,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Map_Ada_Data_Type_Designator
(
Corresponding_Instance
(
O
)));
Append_Node_To_List
(
N
,
ADN
.
Visible_Part
(
Current_Package
));
>>>>>>>
master
-- Link the variable and the object
...
...
@@ -1383,7 +1484,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
O
:=
Next_Node
(
O
);
end
loop
;
end
if
;
end
Visit_Thread_Instance
;
----------------------------
...
...
@@ -3806,6 +3906,10 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
-- list of case alternative of the corresponding thread
-- component.
function
Make_RR_Call
(
Spec
:
Node_Id
;
RR
:
Runtime_Routine
)
return
Node_Id
;
--------------------------
-- Implement_Subprogram --
--------------------------
...
...
@@ -3824,8 +3928,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Else_Statements
:
constant
List_Id
:=
New_List
(
ADN
.
K_List_Id
);
Elsif_Statements
:
constant
List_Id
:=
New_List
(
ADN
.
K_List_Id
);
Pragma_Warnings_Off_Value
:
Value_Id
;
begin
-- Initialize the list associated to the current
-- thread component.
...
...
@@ -3836,6 +3938,13 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Make_Used_Package
(
RU
(
RU_PolyORB_HI_Generated_Deployment
));
Append_Node_To_List
(
N
,
Declarations
);
N
:=
Make_Pragma_Statement
(
Pragma_Unreferenced
,
Make_List_Id
(
Make_Defining_Identifier
(
PN
(
P_Entity
))));
Append_Node_To_List
(
N
,
Declarations
);
-- Build a string literal for the pragma Warnings On|Off:
--
-- if there is no error management, and the
...
...
@@ -3845,6 +3954,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
-- which we exit without entering one of the if
-- statemetns.
<<<<<<<
HEAD
=======
Set_Str_To_Name_Buffer
(
"*return*"
);
Pragma_Warnings_Off_Value
:=
New_String_Value
(
Name_Find
);
...
...
@@ -3860,6 +3971,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
Statements
);
end
if
;
>>>>>>>
master
if
Add_Error_Management
then
N
:=
Make_Qualified_Expression
...
...
@@ -3870,6 +3982,9 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
Else_Statements
);
end
if
;
<<<<<<<
HEAD
-- Add the call to the RR of the current instance
=======
-- Add the alternative of the current instance
Add_Alternative
(
Spec
,
RR
);
...
...
@@ -3889,9 +4004,13 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
ADN
.
Then_Statements
(
ADN
.
First_Node
(
Alternatives
)),
Elsif_Statements
=>
Elsif_Statements
,
Else_Statements
=>
Else_Statements
);
>>>>>>>
master
N
:=
Make_RR_Call
(
Spec
,
RR
);
Append_Node_To_List
(
N
,
Statements
);
<<<<<<<
HEAD
=======
if
(
not
Add_Error_Management
)
and
then
Present
(
ADN
.
Return_Type
(
Spec
))
then
...
...
@@ -3904,6 +4023,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
Statements
);
end
if
;
>>>>>>>
master
-- Make the subprogram implementation
N
:=
...
...
@@ -3914,6 +4034,52 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List
(
N
,
Interrogation_Routine_List
);
end
Implement_Subprogram
;
------------------
-- Make_RR_Call --
------------------
function
Make_RR_Call
(
Spec
:
Node_Id
;
RR
:
Runtime_Routine
)
return
Node_Id
is
Alternatives
:
constant
List_Id
:=
Get_List
(
E
,
RR
);
Actual_Implem
:
constant
Node_Id
:=
Make_Defining_Identifier
(
ADN
.
Name
(
ADN
.
Defining_Identifier
(
Spec
)));
Call_Profile
:
constant
List_Id
:=
New_List
(
ADN
.
K_List_Id
);
Param_Profile
:
constant
List_Id
:=
ADN
.
Parameter_Profile
(
Spec
);
P
:
Node_Id
;
N
:
Node_Id
;
begin
pragma
Assert
(
Alternatives
/=
No_List
);
Set_Homogeneous_Parent_Unit_Name
(
Actual_Implem
,
Make_Defining_Identifier
(
Map_Interrogators_Name
(
E
)));
-- Skip the first parameter of Spec
P
:=
ADN
.
Next_Node
(
ADN
.
First_Node
(
Param_Profile
));
while
Present
(
P
)
loop
N
:=
Make_Defining_Identifier
(
ADN
.
Name
(
ADN
.
Defining_Identifier
(
P
)));
Append_Node_To_List
(
N
,
Call_Profile
);
P
:=
ADN
.
Next_Node
(
P
);
end
loop
;
N
:=
Make_Subprogram_Call
(
Actual_Implem
,
Call_Profile
);
-- If we deal with a function, make a return statement
-- instead of a procedure call.
if
Present
(
ADN
.
Return_Type
(
Spec
))
then
N
:=
Make_Return_Statement
(
N
);
end
if
;
return
N
;
end
Make_RR_Call
;
---------------------
-- Add_Alternative --
---------------------
...
...
@@ -3935,7 +4101,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
(
Actual_Implem
,
Make_Defining_Identifier
(
Map_Interrogators_Name
(
E
)));
-- Skip the first parameter
p
f Spec
-- Skip the first parameter
o
f Spec
P
:=
ADN
.
Next_Node
(
ADN
.
First_Node
(
Param_Profile
));
...
...
@@ -3966,8 +4132,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Extract_Enumerator
(
E
)),
Make_List_Id
(
N
));
Append_Node_To_List
(
N
,
Alternatives
);
end
Add_Alternative
;
begin
-- All the runtime routines below are also generated once
-- per thread component.
...
...
@@ -4004,12 +4170,20 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Add_Alternative
(
Get_Count_Spec
(
E
),
RR_Get_Count
);
Add_Alternative
(
Get_Time_Stamp_Spec
(
E
),
RR_Get_Time_Stamp
);
Add_Alternative
(
Next_Value_Spec
(
E
),
RR_Next_Value
);
<<<<<<<
HEAD
Add_Alternative
(
Store_Received_Message_Spec
(
E
),
RR_Store_Received_Message
);
Add_Alternative
(
Wait_For_Incoming_Events_Spec
(
E
),
RR_Wait_For_Incoming_Events
);
raise
Program_Error
;
=======
Add_Alternative
(
Store_Received_Message_Spec
(
E
),
RR_Store_Received_Message
);
Add_Alternative
(
Wait_For_Incoming_Events_Spec
(
E
),
RR_Wait_For_Incoming_Events
);
>>>>>>>
master
end
if
;
end
;
end
Runtime_Routine_Bodies
;
...
...
src/backends/ocarina-backends-po_hi_ada-runtime.ads
View file @
e5f84c63
...
...
@@ -63,6 +63,7 @@ package Ocarina.Backends.PO_HI_Ada.Runtime is
RU_PolyORB_HI_Hybrid_Task_Driver_Driver
,
RU_PolyORB_HI_Aperiodic_Task
,
RU_PolyORB_HI_Background_Task
,
RU_PolyORB_HI_Null_Task
,
RU_PolyORB_HI_Periodic_Task
,
RU_PolyORB_HI_Sporadic_Task
,
RU_PolyORB_HI_Hybrid_Task
,
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment