git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Robert Dewar 2012-05-15 09:31:25 +00:00 committed by Arnaud Charlet
parent 88e7531beb
commit e7834f95b1
4 changed files with 60 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/ChangeLog
View File

@ -1,3 +1,7 @@
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> 2012-05-15 Robert Dewar <dewar@adacore.com>
* g-comlin.adb, g-comlin.ads: Minor reformatting. * g-comlin.adb, g-comlin.ads: Minor reformatting.

94
gcc/ada/exp_ch9.adb
View File

@ -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
-- 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
(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
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
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;
------------------------- -------------------------
@ -8195,8 +8199,8 @@ package body Exp_Ch9 is
-- the state of the protected object. -- the state of the protected object.
procedure Expand_N_Protected_Body (N : Node_Id) is procedure Expand_N_Protected_Body (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Pid : constant Entity_Id := Corresponding_Spec (N); Pid : constant Entity_Id := Corresponding_Spec (N);
Lock_Free_Active : constant Boolean := Uses_Lock_Free (Pid); Lock_Free_Active : constant Boolean := Uses_Lock_Free (Pid);
-- This flag indicates whether the lock free implementation is active -- This flag indicates whether the lock free implementation is active
@ -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
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);
@ -8540,13 +8544,13 @@ package body Exp_Ch9 is
-- the specs refer to this type. -- the specs refer to this type.
procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Prot_Typ : constant Entity_Id := Defining_Identifier (N); Prot_Typ : constant Entity_Id := Defining_Identifier (N);
Lock_Free_Active : constant Boolean := Uses_Lock_Free (Prot_Typ); Lock_Free_Active : constant Boolean := Uses_Lock_Free (Prot_Typ);
-- This flag indicates whether the lock free implementation is active -- This flag indicates whether the lock free implementation is active
Pdef : constant Node_Id := Protected_Definition (N); Pdef : constant Node_Id := Protected_Definition (N);
-- This contains two lists; one for visible and one for private decls -- This contains two lists; one for visible and one for private decls
Rec_Decl : Node_Id; Rec_Decl : Node_Id;
@ -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
-- 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 =>
Attribute_Name => Name_Address); New_Reference_To (Prot_Proc, Loc),
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
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,31 +8878,29 @@ 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
elsif Has_Entries (Prot_Typ) elsif Has_Entries (Prot_Typ)
or else (Ada_Version >= Ada_2005 or else (Ada_Version >= Ada_2005
and then Present (Interface_List (N))) and then Present (Interface_List (N)))
then then
case Corresponding_Runtime_Package (Prot_Typ) is case Corresponding_Runtime_Package (Prot_Typ) is
when System_Tasking_Protected_Objects_Entries => when System_Tasking_Protected_Objects_Entries =>
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 =>
@ -8918,7 +8918,7 @@ package body Exp_Ch9 is
Object_Comp := Object_Comp :=
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uObject), Make_Defining_Identifier (Loc, Name_uObject),
Component_Definition => Component_Definition =>
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
@ -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,17 +9078,15 @@ 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,
Prefix => New_Reference_To (Bdef, Loc), Prefix => New_Reference_To (Bdef, Loc),
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
-- 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;
@ -12964,7 +12958,7 @@ package body Exp_Ch9 is
elsif Has_Entries (Conc_Typ) elsif Has_Entries (Conc_Typ)
or else or else
(Ada_Version >= Ada_2005 (Ada_Version >= Ada_2005
and then Present (Interface_List (Parent (Conc_Typ)))) and then Present (Interface_List (Parent (Conc_Typ))))
then then
case Corresponding_Runtime_Package (Conc_Typ) is case Corresponding_Runtime_Package (Conc_Typ) is
when System_Tasking_Protected_Objects_Entries => when System_Tasking_Protected_Objects_Entries =>

6
gcc/ada/sem_ch13.adb
View File

@ -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

22
gcc/ada/sem_ch9.adb
View File

@ -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
-- 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
-- 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
-- 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
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
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
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