+2012-05-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch9.adb (Expand_N_Asynchronous_Select): Extract the statements
+ of the abortable part and triggering alternative after being processed
+ for controlled objects.
+ (Expand_N_Timed_Entry_Call): Code and comment reformatting.
+
+2012-05-15 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb: Minor code reorganization.
+
2012-05-15 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.
-----------------------------------
procedure Unhandled_Exception_Terminate is
+
+ -- Comments needed on why we do things this way ??? (see RH)
+
Excep : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value
-- see Expand_N_Entry_Call_Statement.
procedure Expand_N_Asynchronous_Select (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Abrt : constant Node_Id := Abortable_Part (N);
- Astats : constant List_Id := Statements (Abrt);
- Trig : constant Node_Id := Triggering_Alternative (N);
- Tstats : constant List_Id := Statements (Trig);
+ Loc : constant Source_Ptr := Sloc (N);
+ Abrt : constant Node_Id := Abortable_Part (N);
+ Trig : constant Node_Id := Triggering_Alternative (N);
Abort_Block_Ent : Entity_Id;
Abortable_Block : Node_Id;
Actuals : List_Id;
+ Astats : List_Id;
Blk_Ent : Entity_Id;
Blk_Typ : Entity_Id;
Call : Node_Id;
Stmt : Node_Id;
Stmts : List_Id;
TaskE_Stmts : List_Id;
+ Tstats : List_Id;
B : Entity_Id; -- Call status flag
Bnn : Entity_Id; -- Communication block
Process_Statements_For_Controlled_Objects (Trig);
Process_Statements_For_Controlled_Objects (Abrt);
+ -- Retrieve Astats and Tstats now because the finalization machinery may
+ -- wrap them in blocks.
+
+ Astats := Statements (Abrt);
+ Tstats := Statements (Trig);
+
Blk_Ent := Make_Temporary (Loc, 'A');
Ecall := Triggering_Statement (Trig);
procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- E_Call : Node_Id :=
- Entry_Call_Statement (Entry_Call_Alternative (N));
- E_Stats : List_Id; -- statements after entry call
- D_Stat : Node_Id :=
- Delay_Statement (Delay_Alternative (N));
- D_Stats : List_Id; -- statements after "delay ..."
-
Actuals : List_Id;
Blk_Typ : Entity_Id;
Call : Node_Id;
Concval : Node_Id;
D_Conv : Node_Id;
D_Disc : Node_Id;
+ D_Stat : Node_Id;
+ D_Stats : List_Id;
D_Type : Entity_Id;
Decls : List_Id;
Dummy : Node_Id;
+ E_Call : Node_Id;
+ E_Stats : List_Id;
Ename : Node_Id;
Formals : List_Id;
Index : Node_Id;
return;
end if;
+ E_Call := Entry_Call_Statement (Entry_Call_Alternative (N));
+ D_Stat := Delay_Statement (Delay_Alternative (N));
+
Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N));
Process_Statements_For_Controlled_Objects (Delay_Alternative (N));
- -- Must fetch E_Stats/D_Stats after above "Process_...", because it
- -- might modify them.
+ -- Retrieve E_Stats and D_Stats now because the finalization machinery
+ -- may wrap them in blocks.
E_Stats := Statements (Entry_Call_Alternative (N));
D_Stats := Statements (Delay_Alternative (N));
-- Previously we scanned the body to look for nested subprograms, and
-- rejected an inline directive if nested subprograms were present,
-- because the back-end would generate conflicting symbols for the
- -- nested bodies. This is now unecessary.
+ -- nested bodies. This is now unnecessary.
- -- Look ahead to recognize a pragma inline that appears after the body
+ -- Look ahead to recognize a pragma Inline that appears after the body
Check_Inline_Pragma (Spec_Id);
and then Is_Entity_Name (Renamed_Object (Id))
then
return Effective_Extra_Accessibility (Entity (Renamed_Object (Id)));
+ else
+ return Extra_Accessibility (Id);
end if;
-
- return Extra_Accessibility (Id);
end Effective_Extra_Accessibility;
+ ------------------------------
+ -- Enclosing_Comp_Unit_Node --
+ ------------------------------
+
+ function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
+ Current_Node : Node_Id;
+
+ begin
+ Current_Node := N;
+ while Present (Current_Node)
+ and then Nkind (Current_Node) /= N_Compilation_Unit
+ loop
+ Current_Node := Parent (Current_Node);
+ end loop;
+
+ if Nkind (Current_Node) /= N_Compilation_Unit then
+ return Empty;
+ else
+ return Current_Node;
+ end if;
+ end Enclosing_Comp_Unit_Node;
+
--------------------------
-- Enclosing_CPP_Parent --
--------------------------
return Unit_Entity;
end Enclosing_Lib_Unit_Entity;
- ------------------------------
- -- Enclosing_Comp_Unit_Node --
- ------------------------------
-
- function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
- Current_Node : Node_Id;
-
- begin
- Current_Node := N;
- while Present (Current_Node)
- and then Nkind (Current_Node) /= N_Compilation_Unit
- loop
- Current_Node := Parent (Current_Node);
- end loop;
-
- if Nkind (Current_Node) /= N_Compilation_Unit then
- return Empty;
- end if;
-
- return Current_Node;
- end Enclosing_Comp_Unit_Node;
-
-----------------------
-- Enclosing_Package --
-----------------------
-- Same as Einfo.Extra_Accessibility except thtat object renames
-- are looked through.
+ function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
+ -- Returns the enclosing N_Compilation_Unit Node that is the root of a
+ -- subtree containing N.
+
function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id;
-- Returns the closest ancestor of Typ that is a CPP type.
-- root of the current scope (which must not be Standard_Standard, and the
-- caller is responsible for ensuring this condition).
- function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
- -- Returns the enclosing N_Compilation_Unit Node that is the root of a
- -- subtree containing N.
-
function Enclosing_Package (E : Entity_Id) return Entity_Id;
-- Utility function to return the Ada entity of the package enclosing
-- the entity E, if any. Returns Empty if no enclosing package.
projects / gcc.git / commitdiff