Commit b0c9cdca authored by yoogx's avatar yoogx
Browse files

* Defend against incomplete process detection in case of

          threads that are part of a device driver.
parent e5f84c63
...@@ -1039,7 +1039,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1039,7 +1039,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
P : constant Node_Id := ADN.Entity (U); P : constant Node_Id := ADN.Entity (U);
S : Node_Id; S : Node_Id;
N : Node_Id; N : Node_Id;
Scheduling_Protocol : constant Supported_Scheduling_Protocol := Scheduling_Protocol : Supported_Scheduling_Protocol :=
Get_Scheduling_Protocol (Get_Bound_Processor (E)); Get_Scheduling_Protocol (Get_Bound_Processor (E));
The_System : constant Node_Id := The_System : constant Node_Id :=
Parent_Component (Parent_Subcomponent (E)); Parent_Component (Parent_Subcomponent (E));
...@@ -1061,6 +1061,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1061,6 +1061,7 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Fatal => False, Fatal => False,
Warning => True); Warning => True);
Scheduling_Protocol := POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL;
elsif Scheduling_Protocol elsif Scheduling_Protocol
/= POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL /= POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL
and then Scheduling_Protocol /= ROUND_ROBIN_PROTOCOL and then Scheduling_Protocol /= ROUND_ROBIN_PROTOCOL
...@@ -1188,14 +1189,23 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1188,14 +1189,23 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
S : constant Node_Id := Parent_Subcomponent (E); S : constant Node_Id := Parent_Subcomponent (E);
N : Node_Id; N : Node_Id;
O : Node_Id; O : Node_Id;
Scheduling_Protocol : constant Supported_Scheduling_Protocol
:= Get_Scheduling_Protocol Scheduling_Protocol : Supported_Scheduling_Protocol
(Get_Bound_Processor := Unknown_Scheduler;
(Corresponding_Instance Process_Node : Node_Id;
(Get_Container_Process
(Parent_Subcomponent (E)))));
begin begin
-- Determine the scheduler that controls the current thread instance
Process_Node := Get_Container_Process
(Parent_Subcomponent (E));
if Present (Process_Node) then
Scheduling_Protocol := Get_Scheduling_Protocol
(Get_Bound_Processor
(Corresponding_Instance (Process_Node)));
end if;
if Has_Ports (E) then if Has_Ports (E) then
-- The data types and the interrogation routines -- The data types and the interrogation routines
-- generated from a thread are not instance specific. We -- generated from a thread are not instance specific. We
...@@ -1283,7 +1293,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1283,7 +1293,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
case P is case P is
when Thread_Periodic => when Thread_Periodic =>
<<<<<<< HEAD
N := Message_Comment N := Message_Comment
("Periodic task : " ("Periodic task : "
& Get_Name_String (Display_Name (Identifier (S)))); & Get_Name_String (Display_Name (Identifier (S))));
...@@ -1317,47 +1326,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1317,47 +1326,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
N := Message_Comment N := Message_Comment
("ISR task : " ("ISR task : "
& Get_Name_String (Display_Name (Identifier (S)))); & Get_Name_String (Display_Name (Identifier (S))));
=======
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))));
>>>>>>> master
Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
when others => when others =>
...@@ -1376,17 +1344,15 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1376,17 +1344,15 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
-- For each AADL thread, we instantiate a task. -- For each AADL thread, we instantiate a task.
<<<<<<< HEAD if Scheduling_Protocol = ROUND_ROBIN_PROTOCOL then
if Scheduling_Protocol = POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL N := Null_Task_Instantiation (E);
then Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
else
-- Default case : FIFO_WITHIN_PRIORITIES
case P is case P is
when Thread_Periodic => when Thread_Periodic =>
-- Instantiate the periodic task -- Instantiate the periodic task
=======
case P is
when Thread_Periodic =>
-- Instantiate the periodic task
>>>>>>> master
N := Periodic_Task_Instantiation (E); N := Periodic_Task_Instantiation (E);
Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
...@@ -1409,13 +1375,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1409,13 +1375,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
N := Aperiodic_Task_Instantiation (E); N := Aperiodic_Task_Instantiation (E);
Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
<<<<<<< HEAD
when Thread_Background => when Thread_Background =>
-- Instantiate the background task -- Instantiate the background task
=======
when Thread_Background =>
-- Instantiate the background task
>>>>>>> master
N := Background_Task_Instantiation (E); N := Background_Task_Instantiation (E);
Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
...@@ -1429,13 +1390,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1429,13 +1390,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
when others => when others =>
raise Program_Error; raise Program_Error;
end case; 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; end if;
if Has_Modes (E) then if Has_Modes (E) then
...@@ -1459,22 +1413,12 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -1459,22 +1413,12 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
while Present (O) loop while Present (O) loop
if AINU.Is_Data (Corresponding_Instance (O)) then if AINU.Is_Data (Corresponding_Instance (O)) then
<<<<<<< HEAD
N := Make_Object_Declaration N := Make_Object_Declaration
(Defining_Identifier => Map_Ada_Defining_Identifier (O), (Defining_Identifier => Map_Ada_Defining_Identifier (O),
Object_Definition => Map_Ada_Data_Type_Designator Object_Definition => Map_Ada_Data_Type_Designator
(Corresponding_Instance (O))); (Corresponding_Instance (O)));
Append_Node_To_List Append_Node_To_List
(N, ADN.Visible_Part (Current_Package)); (N, ADN.Visible_Part (Current_Package));
=======
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));
>>>>>>> master
-- Link the variable and the object -- Link the variable and the object
...@@ -3928,6 +3872,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3928,6 +3872,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Else_Statements : constant List_Id := New_List (ADN.K_List_Id); Else_Statements : constant List_Id := New_List (ADN.K_List_Id);
Elsif_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 begin
-- Initialize the list associated to the current -- Initialize the list associated to the current
-- thread component. -- thread component.
...@@ -3954,8 +3900,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3954,8 +3900,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
-- which we exit without entering one of the if -- which we exit without entering one of the if
-- statemetns. -- statemetns.
<<<<<<< HEAD
=======
Set_Str_To_Name_Buffer ("*return*"); Set_Str_To_Name_Buffer ("*return*");
Pragma_Warnings_Off_Value := New_String_Value (Name_Find); Pragma_Warnings_Off_Value := New_String_Value (Name_Find);
...@@ -3971,7 +3915,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3971,7 +3915,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
end if; end if;
>>>>>>> master
if Add_Error_Management then if Add_Error_Management then
N := N :=
Make_Qualified_Expression Make_Qualified_Expression
...@@ -3982,9 +3925,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3982,9 +3925,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List (N, Else_Statements); Append_Node_To_List (N, Else_Statements);
end if; end if;
<<<<<<< HEAD
-- Add the call to the RR of the current instance
=======
-- Add the alternative of the current instance -- Add the alternative of the current instance
Add_Alternative (Spec, RR); Add_Alternative (Spec, RR);
...@@ -4004,13 +3944,10 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -4004,13 +3944,10 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
ADN.Then_Statements (ADN.First_Node (Alternatives)), ADN.Then_Statements (ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements, Elsif_Statements => Elsif_Statements,
Else_Statements => Else_Statements); Else_Statements => Else_Statements);
>>>>>>> master
N := Make_RR_Call (Spec, RR); N := Make_RR_Call (Spec, RR);
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
<<<<<<< HEAD
=======
if (not Add_Error_Management) if (not Add_Error_Management)
and then Present (ADN.Return_Type (Spec)) and then Present (ADN.Return_Type (Spec))
then then
...@@ -4023,7 +3960,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -4023,7 +3960,6 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
end if; end if;
>>>>>>> master
-- Make the subprogram implementation -- Make the subprogram implementation
N := N :=
...@@ -4170,20 +4106,12 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -4170,20 +4106,12 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
Add_Alternative (Get_Count_Spec (E), RR_Get_Count); Add_Alternative (Get_Count_Spec (E), RR_Get_Count);
Add_Alternative (Get_Time_Stamp_Spec (E), RR_Get_Time_Stamp); Add_Alternative (Get_Time_Stamp_Spec (E), RR_Get_Time_Stamp);
Add_Alternative (Next_Value_Spec (E), RR_Next_Value); 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 Add_Alternative
(Store_Received_Message_Spec (E), (Store_Received_Message_Spec (E),
RR_Store_Received_Message); RR_Store_Received_Message);
Add_Alternative Add_Alternative
(Wait_For_Incoming_Events_Spec (E), (Wait_For_Incoming_Events_Spec (E),
RR_Wait_For_Incoming_Events); RR_Wait_For_Incoming_Events);
>>>>>>> master
end if; end if;
end; end;
end Runtime_Routine_Bodies; end Runtime_Routine_Bodies;
......
...@@ -945,9 +945,8 @@ package body Ocarina.Backends.Utils is ...@@ -945,9 +945,8 @@ package body Ocarina.Backends.Utils is
--------------------------- ---------------------------
function Get_Container_Process (E : Node_Id) return Node_Id is function Get_Container_Process (E : Node_Id) return Node_Id is
begin
pragma Assert (Present (E)); pragma Assert (Present (E));
begin
case Kind (E) is case Kind (E) is
when K_Call_Instance => when K_Call_Instance =>
return Get_Container_Process (Parent_Sequence (E)); return Get_Container_Process (Parent_Sequence (E));
...@@ -965,6 +964,14 @@ package body Ocarina.Backends.Utils is ...@@ -965,6 +964,14 @@ package body Ocarina.Backends.Utils is
elsif Is_Process (E) or else Is_Device (E) then elsif Is_Process (E) or else Is_Device (E) then
return Parent_Subcomponent (E); return Parent_Subcomponent (E);
elsif Is_Abstract (E) then
-- It is allowed for a thread to be part of an
-- abstract component (e.g. a device driver). In this
-- case, we cannot retrieve the corresponding process
-- instance.
return No_Node;
else else
raise Program_Error raise Program_Error
with "Wrong node kind in " & with "Wrong node kind in " &
......
...@@ -158,7 +158,8 @@ package Ocarina.Backends.Utils is ...@@ -158,7 +158,8 @@ package Ocarina.Backends.Utils is
function Get_Container_Process (E : Node_Id) return Node_Id; function Get_Container_Process (E : Node_Id) return Node_Id;
-- Return the process subcomponent instance that contains the -- Return the process subcomponent instance that contains the
-- subprogram call or thread instance E. -- subprogram call or thread instance E, return No_Node if it
-- cannot be determined.
function Get_Container_Thread (E : Node_Id) return Node_Id; function Get_Container_Thread (E : Node_Id) return Node_Id;
-- Return the thread subcomponent instance that contains the -- Return the thread subcomponent instance that contains the
......
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