Commit e7834f95 by Robert Dewar Committed by Arnaud Charlet

exp_ch9.adb, [...]: Minor reformatting.

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, sem_ch9.adb, sem_ch13.adb: Minor reformatting.

From-SVN: r187506
parent 88e7531b
2012-05-15 Robert Dewar <dewar@adacore.com> 2012-05-15 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, sem_ch9.adb, sem_ch13.adb: Minor reformatting.
2012-05-15 Robert Dewar <dewar@adacore.com>
* g-comlin.adb, g-comlin.ads: Minor reformatting. * g-comlin.adb, g-comlin.ads: Minor reformatting.
2012-05-15 Vincent Pucci <pucci@adacore.com> 2012-05-15 Vincent Pucci <pucci@adacore.com>
......
...@@ -3253,6 +3253,9 @@ package body Exp_Ch9 is ...@@ -3253,6 +3253,9 @@ package body Exp_Ch9 is
begin begin
-- Get the type size -- Get the type size
-- Surely this should be Known_Static_Esize if you are about
-- to assume you can do UI_To_Int on it! ???
if Known_Esize (Comp_Type) then if Known_Esize (Comp_Type) then
Typ_Size := UI_To_Int (Esize (Comp_Type)); Typ_Size := UI_To_Int (Esize (Comp_Type));
...@@ -3260,6 +3263,8 @@ package body Exp_Ch9 is ...@@ -3260,6 +3263,8 @@ package body Exp_Ch9 is
-- the RM_Size (Value_Size) since it may have been set by an -- the RM_Size (Value_Size) since it may have been set by an
-- explicit representation clause. -- explicit representation clause.
-- And how do we know this is statically known???
else else
Typ_Size := UI_To_Int (RM_Size (Comp_Type)); Typ_Size := UI_To_Int (RM_Size (Comp_Type));
end if; end if;
...@@ -3359,6 +3364,7 @@ package body Exp_Ch9 is ...@@ -3359,6 +3364,7 @@ package body Exp_Ch9 is
(Stmts, Compare, Unsigned, Comp, Saved_Comp, Current_Comp); (Stmts, Compare, Unsigned, Comp, Saved_Comp, Current_Comp);
-- Generate: -- Generate:
-- exit when System.Atomic_Primitives.Atomic_Compare_Exchange -- exit when System.Atomic_Primitives.Atomic_Compare_Exchange
-- (Comp'Address, -- (Comp'Address,
-- Interfaces.Unsigned (Saved_Comp), -- Interfaces.Unsigned (Saved_Comp),
...@@ -3397,16 +3403,15 @@ package body Exp_Ch9 is ...@@ -3397,16 +3403,15 @@ package body Exp_Ch9 is
if Present (Label_Id) then if Present (Label_Id) then
Label := Make_Label (Loc, Label_Id); Label := Make_Label (Loc, Label_Id);
Append_To (Decls, Append_To (Decls,
Make_Implicit_Label_Declaration (Loc, Make_Implicit_Label_Declaration (Loc,
Defining_Identifier => Entity (Label_Id), Defining_Identifier => Entity (Label_Id),
Label_Construct => Label)); Label_Construct => Label));
Append_To (Stmts, Label); Append_To (Stmts, Label);
end if; end if;
-- Generate: -- Generate:
-- loop -- loop
-- declare -- declare
-- <Decls> -- <Decls>
...@@ -3446,8 +3451,7 @@ package body Exp_Ch9 is ...@@ -3446,8 +3451,7 @@ package body Exp_Ch9 is
Build_Protected_Sub_Specification (N, Prot_Typ, Unprotected_Mode), Build_Protected_Sub_Specification (N, Prot_Typ, Unprotected_Mode),
Declarations => Decls, Declarations => Decls,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts));
Statements => Stmts));
end Build_Lock_Free_Unprotected_Subprogram_Body; end Build_Lock_Free_Unprotected_Subprogram_Body;
------------------------- -------------------------
...@@ -8258,7 +8262,6 @@ package body Exp_Ch9 is ...@@ -8258,7 +8262,6 @@ package body Exp_Ch9 is
while Present (Formal) loop while Present (Formal) loop
Append_To (Actuals, Append_To (Actuals,
Make_Identifier (Loc, Chars (Defining_Identifier (Formal)))); Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
Next (Formal); Next (Formal);
end loop; end loop;
...@@ -8269,6 +8272,7 @@ package body Exp_Ch9 is ...@@ -8269,6 +8272,7 @@ package body Exp_Ch9 is
Name => Name =>
New_Reference_To (Corresponding_Spec (Prot_Bod), Loc), New_Reference_To (Corresponding_Spec (Prot_Bod), Loc),
Parameter_Associations => Actuals)); Parameter_Associations => Actuals));
else else
pragma Assert (Nkind (Spec) = N_Function_Specification); pragma Assert (Nkind (Spec) = N_Function_Specification);
...@@ -8621,7 +8625,7 @@ package body Exp_Ch9 is ...@@ -8621,7 +8625,7 @@ package body Exp_Ch9 is
return True; return True;
-- Any other types will be checked by the back-end -- Any other type will be checked by the back-end
else else
return True; return True;
...@@ -8637,21 +8641,20 @@ package body Exp_Ch9 is ...@@ -8637,21 +8641,20 @@ package body Exp_Ch9 is
-- All semantic checks already done in Sem_Prag -- All semantic checks already done in Sem_Prag
Prot_Proc : constant Entity_Id := Prot_Proc : constant Entity_Id :=
Defining_Unit_Name Defining_Unit_Name (Specification (Current_Node));
(Specification (Current_Node));
Proc_Address : constant Node_Id := Proc_Address : constant Node_Id :=
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Prot_Proc, Loc), Prefix =>
New_Reference_To (Prot_Proc, Loc),
Attribute_Name => Name_Address); Attribute_Name => Name_Address);
RTS_Call : constant Entity_Id := RTS_Call : constant Entity_Id :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Reference_To ( New_Reference_To
RTE (RE_Register_Interrupt_Handler), Loc), (RTE (RE_Register_Interrupt_Handler), Loc),
Parameter_Associations => Parameter_Associations => New_List (Proc_Address));
New_List (Proc_Address));
begin begin
Append_Freeze_Action (Prot_Proc, RTS_Call); Append_Freeze_Action (Prot_Proc, RTS_Call);
end Register_Handler; end Register_Handler;
...@@ -8857,16 +8860,15 @@ package body Exp_Ch9 is ...@@ -8857,16 +8860,15 @@ package body Exp_Ch9 is
Protection_Subtype := Protection_Subtype :=
New_Reference_To (RTE (RE_Protection), Loc); New_Reference_To (RTE (RE_Protection), Loc);
end if; end if;
else else
Protection_Subtype := Protection_Subtype :=
Make_Subtype_Indication Make_Subtype_Indication (Loc,
(Sloc => Loc,
Subtype_Mark => Subtype_Mark =>
New_Reference_To New_Reference_To
(RTE (RE_Static_Interrupt_Protection), Loc), (RTE (RE_Static_Interrupt_Protection), Loc),
Constraint => Constraint =>
Make_Index_Or_Discriminant_Constraint ( Make_Index_Or_Discriminant_Constraint (Loc,
Sloc => Loc,
Constraints => New_List ( Constraints => New_List (
Entry_Count_Expr, Entry_Count_Expr,
Make_Integer_Literal (Loc, Num_Attach_Handler)))); Make_Integer_Literal (Loc, Num_Attach_Handler))));
...@@ -8876,13 +8878,12 @@ package body Exp_Ch9 is ...@@ -8876,13 +8878,12 @@ package body Exp_Ch9 is
and then not Restriction_Active (No_Dynamic_Attachment) and then not Restriction_Active (No_Dynamic_Attachment)
then then
Protection_Subtype := Protection_Subtype :=
Make_Subtype_Indication ( Make_Subtype_Indication (Loc,
Sloc => Loc, Subtype_Mark =>
Subtype_Mark => New_Reference_To New_Reference_To
(RTE (RE_Dynamic_Interrupt_Protection), Loc), (RTE (RE_Dynamic_Interrupt_Protection), Loc),
Constraint => Constraint =>
Make_Index_Or_Discriminant_Constraint ( Make_Index_Or_Discriminant_Constraint (Loc,
Sloc => Loc,
Constraints => New_List (Entry_Count_Expr))); Constraints => New_List (Entry_Count_Expr)));
-- Type has explicit entries or generated primitive entry wrappers -- Type has explicit entries or generated primitive entry wrappers
...@@ -8896,11 +8897,10 @@ package body Exp_Ch9 is ...@@ -8896,11 +8897,10 @@ package body Exp_Ch9 is
Protection_Subtype := Protection_Subtype :=
Make_Subtype_Indication (Loc, Make_Subtype_Indication (Loc,
Subtype_Mark => Subtype_Mark =>
New_Reference_To (RTE (RE_Protection_Entries), New_Reference_To
Loc), (RTE (RE_Protection_Entries), Loc),
Constraint => Constraint =>
Make_Index_Or_Discriminant_Constraint ( Make_Index_Or_Discriminant_Constraint (Loc,
Sloc => Loc,
Constraints => New_List (Entry_Count_Expr))); Constraints => New_List (Entry_Count_Expr)));
when System_Tasking_Protected_Objects_Single_Entry => when System_Tasking_Protected_Objects_Single_Entry =>
...@@ -8969,9 +8969,7 @@ package body Exp_Ch9 is ...@@ -8969,9 +8969,7 @@ package body Exp_Ch9 is
-- internal operations. -- internal operations.
E_Count := 0; E_Count := 0;
Comp := First (Visible_Declarations (Pdef)); Comp := First (Visible_Declarations (Pdef));
while Present (Comp) loop while Present (Comp) loop
if Nkind (Comp) = N_Subprogram_Declaration then if Nkind (Comp) = N_Subprogram_Declaration then
Sub := Sub :=
...@@ -9080,7 +9078,7 @@ package body Exp_Ch9 is ...@@ -9080,7 +9078,7 @@ package body Exp_Ch9 is
-- Collect pointers to the protected subprogram and the barrier -- Collect pointers to the protected subprogram and the barrier
-- of the current entry, for insertion into Entry_Bodies_Array. -- of the current entry, for insertion into Entry_Bodies_Array.
Append ( Append_To (Expressions (Entries_Aggr),
Make_Aggregate (Loc, Make_Aggregate (Loc,
Expressions => New_List ( Expressions => New_List (
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -9088,9 +9086,7 @@ package body Exp_Ch9 is ...@@ -9088,9 +9086,7 @@ package body Exp_Ch9 is
Attribute_Name => Name_Unrestricted_Access), Attribute_Name => Name_Unrestricted_Access),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Edef, Loc), Prefix => New_Reference_To (Edef, Loc),
Attribute_Name => Name_Unrestricted_Access))), Attribute_Name => Name_Unrestricted_Access))));
Expressions (Entries_Aggr));
end if; end if;
Next (Comp); Next (Comp);
...@@ -12935,9 +12931,7 @@ package body Exp_Ch9 is ...@@ -12935,9 +12931,7 @@ package body Exp_Ch9 is
-- any protected entry (family) of subprogram. Note for the lock-free -- any protected entry (family) of subprogram. Note for the lock-free
-- implementation, the Protection object is not needed anymore. -- implementation, the Protection object is not needed anymore.
if Is_Protected if Is_Protected and then not Uses_Lock_Free (Conc_Typ) then
and then not Uses_Lock_Free (Conc_Typ)
then
declare declare
Prot_Ent : constant Entity_Id := Make_Temporary (Loc, 'R'); Prot_Ent : constant Entity_Id := Make_Temporary (Loc, 'R');
Prot_Typ : RE_Id; Prot_Typ : RE_Id;
......
...@@ -944,16 +944,14 @@ package body Sem_Ch13 is ...@@ -944,16 +944,14 @@ package body Sem_Ch13 is
-- Set the Uses_Lock_Free flag to True if there is no -- Set the Uses_Lock_Free flag to True if there is no
-- expression or if the expression is True. -- expression or if the expression is True.
if No (Expr) if No (Expr) or else Is_True (Static_Boolean (Expr)) then
or else Is_True (Static_Boolean (Expr))
then
Set_Uses_Lock_Free (E); Set_Uses_Lock_Free (E);
end if; end if;
goto Continue; goto Continue;
end if; end if;
-- For all of these aspects we just create a matching pragma -- For all other aspects we just create a matching pragma
-- and insert it, if the expression is missing or set to -- and insert it, if the expression is missing or set to
-- True. If the expression is False, we can ignore the -- True. If the expression is False, we can ignore the
-- aspect with the exception that in the case of a derived -- aspect with the exception that in the case of a derived
......
...@@ -70,9 +70,8 @@ package body Sem_Ch9 is ...@@ -70,9 +70,8 @@ package body Sem_Ch9 is
function Allows_Lock_Free_Implementation function Allows_Lock_Free_Implementation
(N : Node_Id; (N : Node_Id;
Complain : Boolean := False) return Boolean; Complain : Boolean := False) return Boolean;
-- This dispatch routine return True if N satisfies the following list of -- This routine returns True iff N satisfies the following list of lock-
-- lock-free restrictions for protected type declaration and protected -- free restrictions for protected type declaration and protected body:
-- body:
-- --
-- 1) Protected type declaration -- 1) Protected type declaration
-- May not contain entries -- May not contain entries
...@@ -87,8 +86,7 @@ package body Sem_Ch9 is ...@@ -87,8 +86,7 @@ package body Sem_Ch9 is
-- May not contain loop statements or procedure calls -- May not contain loop statements or procedure calls
-- Function calls and attribute references must be static -- Function calls and attribute references must be static
-- --
-- If Complain is set to True, an error message is issued when return -- If Complain is True, an error message is issued when False is returned
-- False.
procedure Check_Max_Entries (D : Node_Id; R : All_Parameter_Restrictions); procedure Check_Max_Entries (D : Node_Id; R : All_Parameter_Restrictions);
-- Given either a protected definition or a task definition in D, check -- Given either a protected definition or a task definition in D, check
...@@ -134,9 +132,7 @@ package body Sem_Ch9 is ...@@ -134,9 +132,7 @@ package body Sem_Ch9 is
-- flag. When Complain is True, an aspect Lock_Free forces the lock-free -- flag. When Complain is True, an aspect Lock_Free forces the lock-free
-- implementation. In that case, the debug flag is not needed. -- implementation. In that case, the debug flag is not needed.
if not Complain if not Complain and then not Debug_Flag_9 then
and then not Debug_Flag_9
then
return False; return False;
end if; end if;
...@@ -235,7 +231,7 @@ package body Sem_Ch9 is ...@@ -235,7 +231,7 @@ package body Sem_Ch9 is
-- Protected body case -- Protected body case
else else
declare Protected_Body_Case : declare
Decls : constant List_Id := Declarations (N); Decls : constant List_Id := Declarations (N);
Pid : constant Entity_Id := Corresponding_Spec (N); Pid : constant Entity_Id := Corresponding_Spec (N);
Prot_Typ_Decl : constant Node_Id := Parent (Pid); Prot_Typ_Decl : constant Node_Id := Parent (Pid);
...@@ -392,6 +388,8 @@ package body Sem_Ch9 is ...@@ -392,6 +388,8 @@ package body Sem_Ch9 is
end if; end if;
end Satisfies_Lock_Free_Requirements; end Satisfies_Lock_Free_Requirements;
-- Start of processing for Protected_Body_Case
begin begin
Decl := First (Decls); Decl := First (Decls);
...@@ -409,7 +407,7 @@ package body Sem_Ch9 is ...@@ -409,7 +407,7 @@ package body Sem_Ch9 is
Next (Decl); Next (Decl);
end loop; end loop;
end; end Protected_Body_Case;
end if; end if;
return True; return True;
...@@ -1709,8 +1707,8 @@ package body Sem_Ch9 is ...@@ -1709,8 +1707,8 @@ package body Sem_Ch9 is
End_Scope; End_Scope;
-- When a Lock_Free aspect forces the lock-free implementation, check N -- When a Lock_Free aspect forces the lock-free implementation, check N
-- meets all the lock-free restrictions. Otherwise, -- meets all the lock-free restrictions. Otherwise, an error message is
-- Allows_Lock_Free_Implementation issue an error message. -- issued by Allows_Lock_Free_Implementation.
if Uses_Lock_Free (Defining_Identifier (N)) then if Uses_Lock_Free (Defining_Identifier (N)) then
if not Allows_Lock_Free_Implementation (N, Complain => True) then if not Allows_Lock_Free_Implementation (N, Complain => True) then
......
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