Commit e94d3b6e authored by yoogx's avatar yoogx
Browse files

* Update code generation patterns to avoid use of exceptions

parent 8c51a282
...@@ -1127,6 +1127,10 @@ package body Ocarina.Backends.Ada_Tree.Generator is ...@@ -1127,6 +1127,10 @@ package body Ocarina.Backends.Ada_Tree.Generator is
procedure Generate_Elsif_Statement (N : Node_Id) is procedure Generate_Elsif_Statement (N : Node_Id) is
D : Node_Id; D : Node_Id;
begin begin
if No (First_Node (Then_Statements (N))) then
return;
end if;
Write (Tok_Elsif); Write (Tok_Elsif);
Write_Space; Write_Space;
Generate (Condition (N)); Generate (Condition (N));
......
...@@ -3536,7 +3536,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3536,7 +3536,8 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
declare declare
procedure Implement_Subprogram procedure Implement_Subprogram
(Spec : Node_Id; (Spec : Node_Id;
RR : Runtime_Routine); RR : Runtime_Routine;
Add_Error_Management : Boolean := False);
-- Generate a subprogram implementation from the given -- Generate a subprogram implementation from the given
-- interrogation routine spec. The new subprogram uses -- interrogation routine spec. The new subprogram uses
-- the value of the first parameter in order to invoke -- the value of the first parameter in order to invoke
...@@ -3556,43 +3557,99 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3556,43 +3557,99 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
procedure Implement_Subprogram procedure Implement_Subprogram
(Spec : Node_Id; (Spec : Node_Id;
RR : Runtime_Routine) RR : Runtime_Routine;
Add_Error_Management : Boolean := False)
is is
Alternatives : constant List_Id := New_List (ADN.K_List_Id); Alternatives : constant List_Id := New_List (ADN.K_List_Id);
Declarations : constant List_Id := New_List
(ADN.K_Declaration_List);
Statements : constant List_Id := New_List Statements : constant List_Id := New_List
(ADN.K_Statement_List); (ADN.K_Statement_List);
N : Node_Id; N : Node_Id;
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 begin
-- Initialize the list associated to the current -- Initialize the list associated to the current
-- thread component. -- thread component.
Set_List (E, RR, Alternatives); Set_List (E, RR, Alternatives);
-- Raise an error if thread instance not corresponding N := Make_Used_Package
-- to the current component are given (RU (RU_PolyORB_HI_Generated_Deployment));
Append_Node_To_List (N, Declarations);
N := Make_Case_Statement_Alternative -- Build a string literal for the pragma Warnings On|Off:
(No_List, --
Make_List_Id -- if there is no error management, and the
(Make_Raise_Statement -- current subprogram is a function, we need to shut
(Make_Designator -- down the warning on missing return: by construction
(EN (E_Program_Error))))); -- of the source code, there cannot be situation in
Append_Node_To_List (N, Alternatives); -- which we exit without entering one of the if
-- statemetns.
Set_Str_To_Name_Buffer ("*return*");
Pragma_Warnings_Off_Value := New_String_Value (Name_Find);
if (not Add_Error_Management)
and then Present (ADN.Return_Type (Spec))
then
N := Make_Pragma_Statement
(Pragma_Warnings,
Make_List_Id
(RE (RE_Off),
Make_Literal (Pragma_Warnings_Off_Value)));
Append_Node_To_List (N, Statements);
end if;
if Add_Error_Management then
N := Make_Qualified_Expression
(RE (RE_Error_Kind),
Make_Record_Aggregate
(Make_List_Id
(RE (RE_Error_Transport))));
N := Make_Return_Statement (N);
Append_Node_To_List (N, Else_Statements);
end if;
-- Add the alternative of the current instance -- Add the alternative of the current instance
Add_Alternative (Spec, RR); Add_Alternative (Spec, RR);
-- Make the case statement -- Make the if statement: to avoid a useless if
-- statement, we take the head of the Alternatives as
-- first statement, and the tail for the elsif part.
ADN.Set_First_Node (Elsif_Statements,
ADN.Next_Node
(ADN.First_Node (Alternatives)));
N := Make_If_Statement
(Condition => ADN.Condition (ADN.First_Node (Alternatives)),
Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements,
Else_Statements => Else_statements);
N := Make_Case_Statement
(Make_Defining_Identifier (PN (P_Entity)),
Alternatives);
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
if (not Add_Error_Management)
and then Present (ADN.Return_Type (Spec))
then
N := Make_Pragma_Statement
(Pragma_Warnings,
Make_List_Id
(RE (RE_On),
Make_Literal (Pragma_Warnings_Off_Value)));
Append_Node_To_List (N, Statements);
end if;
-- Make the subprogram implementation -- Make the subprogram implementation
N := Make_Subprogram_Implementation (Spec, No_List, Statements); N := Make_Subprogram_Implementation
(Spec, Declarations, Statements);
Append_Node_To_List (N, Interrogation_Routine_List); Append_Node_To_List (N, Interrogation_Routine_List);
end Implement_Subprogram; end Implement_Subprogram;
...@@ -3641,22 +3698,22 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is ...@@ -3641,22 +3698,22 @@ package body Ocarina.Backends.PO_HI_Ada.Activity is
-- Make the alternative -- Make the alternative
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Extract_Enumerator (E)), (Make_Expression
(Make_Defining_Identifier (PN (P_Entity)),
Op_Equal,
Extract_Enumerator (E)),
Make_List_Id (N)); Make_List_Id (N));
Append_Node_To_List (N, Alternatives);
-- We insert N before the 'when others' alternative in
-- order to get a correctly formed case statement.
Insert_Before_Node
(N, ADN.Last_Node (Alternatives), Alternatives);
end Add_Alternative; end Add_Alternative;
begin begin
-- All the runtime routines below are also generated once -- All the runtime routines below are also generated once
-- per thread component. -- per thread component.
if Not_Handled then if Not_Handled then
Implement_Subprogram (Send_Output_Spec (E), RR_Send_Output); Implement_Subprogram
(Send_Output_Spec (E), RR_Send_Output, True);
Implement_Subprogram (Put_Value_Spec (E), RR_Put_Value); Implement_Subprogram (Put_Value_Spec (E), RR_Put_Value);
Implement_Subprogram (Receive_Input_Spec (E), RR_Receive_Input); Implement_Subprogram (Receive_Input_Spec (E), RR_Receive_Input);
Implement_Subprogram (Get_Value_Spec (E), RR_Get_Value); Implement_Subprogram (Get_Value_Spec (E), RR_Get_Value);
......
...@@ -580,11 +580,18 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is ...@@ -580,11 +580,18 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is
(Map_Ada_Component_Name (F))), (Map_Ada_Component_Name (F))),
Make_Defining_Identifier (PN (P_Message)))); Make_Defining_Identifier (PN (P_Message))));
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
else
Append_Node_To_List (Make_Null_Statement,
Statements);
end if; end if;
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Make_Expression
(Extract_Enumerator (F, False)), (Make_Selected_Component
(Make_Designator (PN (P_Data)),
Make_Designator (PN (P_Port))),
Op_Equal,
Extract_Enumerator (F, False)),
Statements); Statements);
Append_Node_To_List (N, Alternatives); Append_Node_To_List (N, Alternatives);
end if; end if;
...@@ -592,22 +599,30 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is ...@@ -592,22 +599,30 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is
F := Next_Node (F); F := Next_Node (F);
end loop; end loop;
N := Make_Case_Statement_Alternative declare
(No_List, Declarations : constant List_Id
Make_List_Id := New_List (ADN.K_Declaration_List);
(Make_Raise_Statement Elsif_Statements : constant List_Id
(Make_Designator := New_List (ADN.K_List_Id);
(EN (E_Program_Error))))); begin
Append_Node_To_List (N, Alternatives); N := Make_Used_Package
(RU (RU_PolyORB_HI_Generated_Activity));
Append_Node_To_List (N, Declarations);
N := Make_Case_Statement ADN.Set_First_Node (Elsif_Statements,
(Make_Selected_Component ADN.Next_Node
(Make_Designator (PN (P_Data)), (ADN.First_Node (Alternatives)));
Make_Designator (PN (P_Port))),
Alternatives);
N := Make_Subprogram_Implementation N := Make_If_Statement
(Spec, No_List, Make_List_Id (N)); (Condition => ADN.Condition
(ADN.First_Node (Alternatives)),
Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements);
N := Make_Subprogram_Implementation
(Spec, Declarations, Make_List_Id (N));
end;
else else
Declarations := New_List (ADN.K_Declaration_List); Declarations := New_List (ADN.K_Declaration_List);
...@@ -742,9 +757,11 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is ...@@ -742,9 +757,11 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is
Make_Record_Aggregate (Aggregates))); Make_Record_Aggregate (Aggregates)));
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Make_Expression
(Extract_Enumerator (F, False)), (Make_Defining_Identifier (PN (P_Port)),
Op_Equal,
Extract_Enumerator (F, False)),
Statements); Statements);
Append_Node_To_List (N, Alternatives); Append_Node_To_List (N, Alternatives);
end if; end if;
...@@ -752,14 +769,6 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is ...@@ -752,14 +769,6 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is
F := Next_Node (F); F := Next_Node (F);
end loop; end loop;
N := Make_Case_Statement_Alternative
(No_List,
Make_List_Id
(Make_Raise_Statement
(Make_Designator
(EN (E_Program_Error)))));
Append_Node_To_List (N, Alternatives);
if not Ref_Message then if not Ref_Message then
-- Add a pragma unreferenced for 'Message' -- Add a pragma unreferenced for 'Message'
...@@ -770,12 +779,31 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is ...@@ -770,12 +779,31 @@ package body Ocarina.Backends.PO_HI_Ada.Marshallers is
Append_Node_To_List (N, Declarations); Append_Node_To_List (N, Declarations);
end if; end if;
N := Make_Case_Statement declare
(Make_Defining_Identifier (PN (P_Port)), -- Declarations : constant List_Id
Alternatives); -- := New_List (ADN.K_Declaration_List);
Elsif_Statements : constant List_Id
:= New_List (ADN.K_List_Id);
begin
N := Make_Used_Package
(RU (RU_PolyORB_HI_Generated_Activity));
Append_Node_To_List (N, Declarations);
ADN.Set_First_Node (Elsif_Statements,
ADN.Next_Node
(ADN.First_Node (Alternatives)));
N := Make_If_Statement
(Condition => ADN.Condition
(ADN.First_Node (Alternatives)),
Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements);
N := Make_Subprogram_Implementation
(Spec, Declarations, Make_List_Id (N));
end;
N := Make_Subprogram_Implementation
(Spec, Declarations, Make_List_Id (N));
else else
-- Add a pragma unreferenced for parameters -- Add a pragma unreferenced for parameters
......
...@@ -313,12 +313,15 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -313,12 +313,15 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
Make_Defining_Identifier (PN (P_Message)))); Make_Defining_Identifier (PN (P_Message))));
Append_Node_To_List (N, Declarations); Append_Node_To_List (N, Declarations);
N := Make_Raise_Statement N := Make_Null_Statement;
(Make_Defining_Identifier (EN (E_Program_Error)));
Append_Node_To_List (N, Statements); Append_Node_To_List (N, Statements);
else else
-- Declarative part -- Declarative part
N := Make_Used_Package
(RU (RU_PolyORB_HI_Generated_Deployment));
Append_Node_To_List (N, Declarations);
N := Make_Object_Declaration N := Make_Object_Declaration
(Defining_Identifier => Make_Defining_Identifier (PN (P_Msg)), (Defining_Identifier => Make_Defining_Identifier (PN (P_Msg)),
Object_Definition => RE (RE_Message_Type)); Object_Definition => RE (RE_Message_Type));
...@@ -419,9 +422,11 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -419,9 +422,11 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
-- The case statement alternative -- The case statement alternative
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Make_Expression
(Extract_Enumerator (Corresponding_Instance (T))), (Make_Defining_Identifier (PN (P_Entity)),
Op_Equal,
Extract_Enumerator (Corresponding_Instance (T))),
Make_List_Id (N)); Make_List_Id (N));
Append_Node_To_List (N, Alternatives); Append_Node_To_List (N, Alternatives);
end if; end if;
...@@ -429,21 +434,22 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -429,21 +434,22 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
T := Next_Node (T); T := Next_Node (T);
end loop; end loop;
-- Raise an error if other threads are targeted. declare
Elsif_Statements : constant List_Id := New_List (ADN.K_List_Id);
N := Make_Case_Statement_Alternative begin
(No_List, ADN.Set_First_Node (Elsif_Statements,
Make_List_Id ADN.Next_Node
(Make_Raise_Statement (ADN.First_Node (Alternatives)));
(Make_Designator
(EN (E_Program_Error)))));
Append_Node_To_List (N, Alternatives);
-- The switch case statement N := Make_If_Statement
(Condition => ADN.Condition (ADN.First_Node (Alternatives)),
Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements);
N := Make_Case_Statement Append_Node_To_List (N, Statements);
(Make_Defining_Identifier (PN (P_Entity)), Alternatives); end;
Append_Node_To_List (N, Statements);
end if; end if;
N := Make_Subprogram_Implementation (Spec, Declarations, Statements); N := Make_Subprogram_Implementation (Spec, Declarations, Statements);
...@@ -486,6 +492,10 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -486,6 +492,10 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
else else
-- Declarative part -- Declarative part
N := Make_Used_Package
(RU (RU_PolyORB_HI_Generated_Deployment));
Append_Node_To_List (N, Declarations);
N := Make_Object_Declaration N := Make_Object_Declaration
(Defining_Identifier => Make_Defining_Identifier (PN (P_Msg)), (Defining_Identifier => Make_Defining_Identifier (PN (P_Msg)),
Constant_Present => True, Constant_Present => True,
...@@ -531,9 +541,11 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -531,9 +541,11 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
-- The case statement alternative -- The case statement alternative
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Make_Expression
(Extract_Enumerator (Corresponding_Instance (T))), (Make_Defining_Identifier (PN (P_From)),
Op_Equal,
Extract_Enumerator (Corresponding_Instance (T))),
Make_List_Id (N)); Make_List_Id (N));
Append_Node_To_List (N, Alternatives); Append_Node_To_List (N, Alternatives);
end if; end if;
...@@ -541,21 +553,32 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -541,21 +553,32 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
T := Next_Node (T); T := Next_Node (T);
end loop; end loop;
-- Raise an error if other threads are targeted. declare
Elsif_Statements : constant List_Id := New_List (ADN.K_List_Id);
Else_Statements : constant List_Id := New_List (ADN.K_List_Id);
N := Make_Case_Statement_Alternative begin
(No_List, N := Make_Qualified_Expression
Make_List_Id (RE (RE_Error_Kind),
(Make_Raise_Statement Make_Record_Aggregate
(Make_Designator (Make_List_Id
(EN (E_Program_Error))))); (RE (RE_Error_Transport))));
Append_Node_To_List (N, Alternatives); N := Make_Return_Statement (N);
Append_Node_To_List (N, Else_Statements);
-- The switch case statement ADN.Set_First_Node (Elsif_Statements,
ADN.Next_Node
(ADN.First_Node (Alternatives)));
N := Make_Case_Statement N := Make_If_Statement
(Make_Defining_Identifier (PN (P_From)), Alternatives); (Condition => ADN.Condition (ADN.First_Node (Alternatives)),
Append_Node_To_List (N, Statements); Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements,
Else_Statements => Else_Statements);
Append_Node_To_List (N, Statements);
end;
end if; end if;
N := Make_Subprogram_Implementation (Spec, Declarations, Statements); N := Make_Subprogram_Implementation (Spec, Declarations, Statements);
...@@ -627,6 +650,10 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -627,6 +650,10 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
-- Declare a local variable of type the thread interface -- Declare a local variable of type the thread interface
N := Make_Used_Package
(RU (RU_PolyORB_HI_Generated_Deployment));
Append_Node_To_List (N, Declarations);
N := Make_Object_Declaration N := Make_Object_Declaration
(Defining_Identifier => Make_Defining_Identifier (Defining_Identifier => Make_Defining_Identifier
(VN (V_Thread_Interface)), (VN (V_Thread_Interface)),
...@@ -716,8 +743,12 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -716,8 +743,12 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
-- Create the case statement alternative -- Create the case statement alternative
N := Make_Case_Statement_Alternative N := Make_Elsif_Statement
(Make_List_Id (Extract_Enumerator (F)), St); (Make_Expression
(Make_Defining_Identifier (PN (P_Port)),
Op_Equal,
Extract_Enumerator (F)),
St);
Append_Node_To_List (N, Alternatives); Append_Node_To_List (N, Alternatives);
end; end;
end if; end if;
...@@ -725,21 +756,22 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is ...@@ -725,21 +756,22 @@ package body Ocarina.Backends.PO_HI_Ada.Transport is
F := Next_Node (F); F := Next_Node (F);
end loop; end loop;
-- Raise an error if other ports are targeted. declare
Elsif_Statements : constant List_Id := New_List (ADN.K_List_Id);
N := Make_Case_Statement_Alternative begin
(No_List, ADN.Set_First_Node (Elsif_Statements,
Make_List_Id ADN.Next_Node
(Make_Raise_Statement (ADN.First_Node (Alternatives)));
(Make_Designator
(EN (E_Program_Error)))));
Append_Node_To_List (N, Alternatives);
-- The switch case statement N := Make_If_Statement
(Condition => ADN.Condition (ADN.First_Node (Alternatives)),
Then_Statements => ADN.Then_Statements
(ADN.First_Node (Alternatives)),
Elsif_Statements => Elsif_Statements);
N := Make_Case_Statement Append_Node_To_List (N, Statements);