Skip to content

R
riscv-gcc-1
Commit 54bf19e4 by Arnaud Charlet
Options

[multiple changes] 

2011-09-06  Robert Dewar  <dewar@adacore.com>

	* s-osinte-linux.ads, a-iteint.ads, exp_ch6.adb, s-solita.adb: Minor
	reformatting.

2011-09-06  Arnaud Charlet  <charlet@adacore.com>

	* s-linux-alpha.ads: Minor reformatting
	* s-oscons-tmplt.c: Fix generated comments in s-oscons template.
	Use sizeof instead of corresponding C defines in s-oscons template.

From-SVN: r178575
parent 5d42cba1
Showing with 147 additions and 132 deletions
gcc/ada/ChangeLog
2011-09-06 Robert Dewar <dewar@adacore.com>
* s-osinte-linux.ads, a-iteint.ads, exp_ch6.adb, s-solita.adb: Minor
reformatting.
2011-09-06 Arnaud Charlet <charlet@adacore.com>
* s-linux-alpha.ads: Minor reformatting
* s-oscons-tmplt.c: Fix generated comments in s-oscons template.
Use sizeof instead of corresponding C defines in s-oscons template.
2011-09-06 Vadim Godunko <godunko@adacore.com> 2011-09-06 Vadim Godunko <godunko@adacore.com>
* a-convec.ads, a-iteint.ads: Minor reformatting. * a-convec.ads, a-iteint.ads: Minor reformatting.
......
gcc/ada/a-iteint.ads
...@@ -22,13 +22,17 @@ package Ada.Iterator_Interfaces is ...@@ -22,13 +22,17 @@ package Ada.Iterator_Interfaces is
pragma Pure; pragma Pure;
type Forward_Iterator is limited interface; type Forward_Iterator is limited interface;
function First (Object : Forward_Iterator) return Cursor is abstract;
function First
(Object : Forward_Iterator) return Cursor is abstract;
function Next function Next
(Object : Forward_Iterator; (Object : Forward_Iterator;
Position : Cursor) return Cursor is abstract; Position : Cursor) return Cursor is abstract;
type Reversible_Iterator is limited interface and Forward_Iterator; type Reversible_Iterator is limited interface and Forward_Iterator;
function Last (Object : Reversible_Iterator) return Cursor is abstract;
function Last
(Object : Reversible_Iterator) return Cursor is abstract;
function Previous function Previous
(Object : Reversible_Iterator; (Object : Reversible_Iterator;
Position : Cursor) return Cursor is abstract; Position : Cursor) return Cursor is abstract;
......
gcc/ada/exp_ch6.adb
...@@ -4031,20 +4031,20 @@ package body Exp_Ch6 is ...@@ -4031,20 +4031,20 @@ package body Exp_Ch6 is
Insert_After (Parent (Entity (N)), Blk); Insert_After (Parent (Entity (N)), Blk);
-- If the context is an assignment, and the left-hand side is -- If the context is an assignment, and the left-hand side is free of
-- free of side-effects, the replacement is also safe. -- side-effects, the replacement is also safe.
-- Can this be generalized further??? -- Can this be generalized further???
elsif Nkind (Parent (N)) = N_Assignment_Statement elsif Nkind (Parent (N)) = N_Assignment_Statement
and then and then
(Is_Entity_Name (Name (Parent (N))) (Is_Entity_Name (Name (Parent (N)))
or else or else
(Nkind (Name (Parent (N))) = N_Explicit_Dereference (Nkind (Name (Parent (N))) = N_Explicit_Dereference
and then Is_Entity_Name (Prefix (Name (Parent (N))))) and then Is_Entity_Name (Prefix (Name (Parent (N)))))
or else or else
(Nkind (Name (Parent (N))) = N_Selected_Component (Nkind (Name (Parent (N))) = N_Selected_Component
and then Is_Entity_Name (Prefix (Name (Parent (N)))))) and then Is_Entity_Name (Prefix (Name (Parent (N))))))
then then
-- Replace assignment with the block -- Replace assignment with the block
...@@ -4210,26 +4210,22 @@ package body Exp_Ch6 is ...@@ -4210,26 +4210,22 @@ package body Exp_Ch6 is
end if; end if;
-- For the unconstrained case, capture the name of the local variable -- For the unconstrained case, capture the name of the local variable
-- that holds the result. This must be the first declaration -- that holds the result. This must be the first declaration in the
-- in the block, because its bounds cannot depend on local variables. -- block, because its bounds cannot depend on local variables. Otherwise
-- Otherwise there is no way to declare the result outside of the -- there is no way to declare the result outside of the block. Needless
-- block. Needless to say, in general the bounds will depend on the -- to say, in general the bounds will depend on the actuals in the call.
-- actuals in the call.
-- If the context is an assignment statement, as is the case for the -- If the context is an assignment statement, as is the case for the
-- expansion of an extended return, the left-hand side provides bounds -- expansion of an extended return, the left-hand side provides bounds
-- even if the return type is unconstrained. -- even if the return type is unconstrained.
if Is_Unc if Is_Unc and then Nkind (Parent (N)) /= N_Assignment_Statement then
and then Nkind (Parent (N)) /= N_Assignment_Statement
then
Targ1 := Defining_Identifier (First (Declarations (Blk))); Targ1 := Defining_Identifier (First (Declarations (Blk)));
end if; end if;
-- If this is a derived function, establish the proper return type -- If this is a derived function, establish the proper return type
if Present (Orig_Subp) if Present (Orig_Subp) and then Orig_Subp /= Subp then
and then Orig_Subp /= Subp
then
Ret_Type := Etype (Orig_Subp); Ret_Type := Etype (Orig_Subp);
else else
Ret_Type := Etype (Subp); Ret_Type := Etype (Subp);
...@@ -4413,7 +4409,7 @@ package body Exp_Ch6 is ...@@ -4413,7 +4409,7 @@ package body Exp_Ch6 is
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Temp, Defining_Identifier => Temp,
Object_Definition => Object_Definition =>
New_Copy_Tree (Object_Definition (Parent (Targ1)))); New_Copy_Tree (Object_Definition (Parent (Targ1))));
Replace_Formals (Decl); Replace_Formals (Decl);
...@@ -4422,8 +4418,7 @@ package body Exp_Ch6 is ...@@ -4422,8 +4418,7 @@ package body Exp_Ch6 is
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Temp, Defining_Identifier => Temp,
Object_Definition => Object_Definition => New_Occurrence_Of (Ret_Type, Loc));
New_Occurrence_Of (Ret_Type, Loc));
Set_Etype (Temp, Ret_Type); Set_Etype (Temp, Ret_Type);
end if; end if;
...@@ -4443,9 +4438,7 @@ package body Exp_Ch6 is ...@@ -4443,9 +4438,7 @@ package body Exp_Ch6 is
Replace_Formals (Blk); Replace_Formals (Blk);
Set_Parent (Blk, N); Set_Parent (Blk, N);
if not Comes_From_Source (Subp) if not Comes_From_Source (Subp) or else Is_Predef then
or else Is_Predef
then
Reset_Slocs (Blk); Reset_Slocs (Blk);
end if; end if;
...@@ -4457,7 +4450,7 @@ package body Exp_Ch6 is ...@@ -4457,7 +4450,7 @@ package body Exp_Ch6 is
if Num_Ret = 1 if Num_Ret = 1
and then and then
Nkind (Last (Statements (Handled_Statement_Sequence (Blk)))) = Nkind (Last (Statements (Handled_Statement_Sequence (Blk)))) =
N_Goto_Statement N_Goto_Statement
then then
Remove (Last (Statements (Handled_Statement_Sequence (Blk)))); Remove (Last (Statements (Handled_Statement_Sequence (Blk))));
else else
...@@ -4495,6 +4488,7 @@ package body Exp_Ch6 is ...@@ -4495,6 +4488,7 @@ package body Exp_Ch6 is
if Ekind (Subp) = E_Procedure then if Ekind (Subp) = E_Procedure then
Rewrite_Procedure_Call (N, Blk); Rewrite_Procedure_Call (N, Blk);
else else
Rewrite_Function_Call (N, Blk); Rewrite_Function_Call (N, Blk);
...@@ -4956,12 +4950,12 @@ package body Exp_Ch6 is ...@@ -4956,12 +4950,12 @@ package body Exp_Ch6 is
Set_Identifier Set_Identifier
(Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc)); (Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
-- If the object decl was already rewritten as a renaming, then -- If the object decl was already rewritten as a renaming, then we
-- we don't want to do the object allocation and transformation of -- don't want to do the object allocation and transformation of of
-- of the return object declaration to a renaming. This case occurs -- the return object declaration to a renaming. This case occurs
-- when the return object is initialized by a call to another -- when the return object is initialized by a call to another
-- build-in-place function, and that function is responsible for the -- build-in-place function, and that function is responsible for
-- allocation of the return object. -- the allocation of the return object.
if Is_Build_In_Place if Is_Build_In_Place
and then Nkind (Ret_Obj_Decl) = N_Object_Renaming_Declaration and then Nkind (Ret_Obj_Decl) = N_Object_Renaming_Declaration
...@@ -5245,9 +5239,9 @@ package body Exp_Ch6 is ...@@ -5245,9 +5239,9 @@ package body Exp_Ch6 is
-- The allocator is returned on the secondary stack, -- The allocator is returned on the secondary stack,
-- so indicate that the function return, as well as -- so indicate that the function return, as well as
-- the block that encloses the allocator, must not -- the block that encloses the allocator, must not
-- release it. The flags must be set now because the -- release it. The flags must be set now because
-- decision to use the secondary stack is done very -- the decision to use the secondary stack is done
-- late in the course of expanding the return -- very late in the course of expanding the return
-- statement, past the point where these flags are -- statement, past the point where these flags are
-- normally set. -- normally set.
...@@ -5324,10 +5318,10 @@ package body Exp_Ch6 is ...@@ -5324,10 +5318,10 @@ package body Exp_Ch6 is
-- If a separate initialization assignment was created -- If a separate initialization assignment was created
-- earlier, append that following the assignment of the -- earlier, append that following the assignment of the
-- implicit access formal to the access object, to ensure -- implicit access formal to the access object, to ensure
-- that the return object is initialized in that case. -- that the return object is initialized in that case. In
-- In this situation, the target of the assignment must -- this situation, the target of the assignment must be
-- be rewritten to denote a dereference of the access to -- rewritten to denote a dereference of the access to the
-- the return object passed in by the caller. -- return object passed in by the caller.
if Present (Init_Assignment) then if Present (Init_Assignment) then
Rewrite (Name (Init_Assignment), Rewrite (Name (Init_Assignment),
...@@ -5975,10 +5969,10 @@ package body Exp_Ch6 is ...@@ -5975,10 +5969,10 @@ package body Exp_Ch6 is
Pop_Scope; Pop_Scope;
end if; end if;
-- Ada 2005 (AI-348): Generate body for a null procedure. -- Ada 2005 (AI-348): Generate body for a null procedure. In most
-- In most cases this is superfluous because calls to it -- cases this is superfluous because calls to it will be automatically
-- will be automatically inlined, but we definitely need -- inlined, but we definitely need the body if preconditions for the
-- the body if preconditions for the procedure are present. -- procedure are present.
elsif Nkind (Specification (N)) = N_Procedure_Specification elsif Nkind (Specification (N)) = N_Procedure_Specification
and then Null_Present (Specification (N)) and then Null_Present (Specification (N))
...@@ -6016,11 +6010,11 @@ package body Exp_Ch6 is ...@@ -6016,11 +6010,11 @@ package body Exp_Ch6 is
begin begin
-- Call _Postconditions procedure if procedure with active -- Call _Postconditions procedure if procedure with active
-- postconditions. Here, we use the Postcondition_Proc attribute, which -- postconditions. Here, we use the Postcondition_Proc attribute,
-- is needed for implicitly-generated returns. Functions never -- which is needed for implicitly-generated returns. Functions
-- have implicitly-generated returns, and there's no room for -- never have implicitly-generated returns, and there's no
-- Postcondition_Proc in E_Function, so we look up the identifier -- room for Postcondition_Proc in E_Function, so we look up the
-- Name_uPostconditions for function returns (see -- identifier Name_uPostconditions for function returns (see
-- Expand_Simple_Function_Return). -- Expand_Simple_Function_Return).
if Ekind (Scope_Id) = E_Procedure if Ekind (Scope_Id) = E_Procedure
...@@ -6225,13 +6219,13 @@ package body Exp_Ch6 is ...@@ -6225,13 +6219,13 @@ package body Exp_Ch6 is
Rec : Node_Id; Rec : Node_Id;
begin begin
-- If the protected object is not an enclosing scope, this is an -- If the protected object is not an enclosing scope, this is an inter-
-- inter-object function call. Inter-object procedure calls are expanded -- object function call. Inter-object procedure calls are expanded by
-- by Exp_Ch9.Build_Simple_Entry_Call. The call is intra-object only if -- Exp_Ch9.Build_Simple_Entry_Call. The call is intra-object only if the
-- the subprogram being called is in the protected body being compiled, -- subprogram being called is in the protected body being compiled, and
-- and if the protected object in the call is statically the enclosing -- if the protected object in the call is statically the enclosing type.
-- type. The object may be an component of some other data structure, in -- The object may be an component of some other data structure, in which
-- which case this must be handled as an inter-object call. -- case this must be handled as an inter-object call.
if not In_Open_Scopes (Scop) if not In_Open_Scopes (Scop)
or else not Is_Entity_Name (Name (N)) or else not Is_Entity_Name (Name (N))
...@@ -6311,8 +6305,8 @@ package body Exp_Ch6 is ...@@ -6311,8 +6305,8 @@ package body Exp_Ch6 is
-- Expand_Simple_Function_Return -- -- Expand_Simple_Function_Return --
----------------------------------- -----------------------------------
-- The "simple" comes from the syntax rule simple_return_statement. -- The "simple" comes from the syntax rule simple_return_statement. The
-- The semantics are not at all simple! -- semantics are not at all simple!
procedure Expand_Simple_Function_Return (N : Node_Id) is procedure Expand_Simple_Function_Return (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
...@@ -6333,12 +6327,12 @@ package body Exp_Ch6 is ...@@ -6333,12 +6327,12 @@ package body Exp_Ch6 is
-- The type of the expression (not necessarily the same as R_Type) -- The type of the expression (not necessarily the same as R_Type)
Subtype_Ind : Node_Id; Subtype_Ind : Node_Id;
-- If the result type of the function is class-wide and the -- If the result type of the function is class-wide and the expression
-- expression has a specific type, then we use the expression's -- has a specific type, then we use the expression's type as the type of
-- type as the type of the return object. In cases where the -- the return object. In cases where the expression is an aggregate that
-- expression is an aggregate that is built in place, this avoids -- is built in place, this avoids the need for an expensive conversion
-- the need for an expensive conversion of the return object to -- of the return object to the specific type on assignments to the
-- the specific type on assignments to the individual components. -- individual components.
begin begin
if Is_Class_Wide_Type (R_Type) if Is_Class_Wide_Type (R_Type)
...@@ -6502,13 +6496,13 @@ package body Exp_Ch6 is ...@@ -6502,13 +6496,13 @@ package body Exp_Ch6 is
-- Optimize the case where the result is a function call. In this -- Optimize the case where the result is a function call. In this
-- case either the result is already on the secondary stack, or is -- case either the result is already on the secondary stack, or is
-- already being returned with the stack pointer depressed and no -- already being returned with the stack pointer depressed and no
-- further processing is required except to set the By_Ref flag to -- further processing is required except to set the By_Ref flag
-- ensure that gigi does not attempt an extra unnecessary copy. -- to ensure that gigi does not attempt an extra unnecessary copy.
-- (actually not just unnecessary but harmfully wrong in the case -- (actually not just unnecessary but harmfully wrong in the case
-- of a controlled type, where gigi does not know how to do a copy). -- of a controlled type, where gigi does not know how to do a copy).
-- To make up for a gcc 2.8.1 deficiency (???), we perform -- To make up for a gcc 2.8.1 deficiency (???), we perform the copy
-- the copy for array types if the constrained status of the -- for array types if the constrained status of the target type is
-- target type is different from that of the expression. -- different from that of the expression.
if Requires_Transient_Scope (Exptyp) if Requires_Transient_Scope (Exptyp)
and then and then
...@@ -6602,12 +6596,12 @@ package body Exp_Ch6 is ...@@ -6602,12 +6596,12 @@ package body Exp_Ch6 is
end if; end if;
end if; end if;
-- Implement the rules of 6.5(8-10), which require a tag check in the -- Implement the rules of 6.5(8-10), which require a tag check in
-- case of a limited tagged return type, and tag reassignment for -- the case of a limited tagged return type, and tag reassignment for
-- nonlimited tagged results. These actions are needed when the return -- nonlimited tagged results. These actions are needed when the return
-- type is a specific tagged type and the result expression is a -- type is a specific tagged type and the result expression is a
-- conversion or a formal parameter, because in that case the tag of the -- conversion or a formal parameter, because in that case the tag of
-- expression might differ from the tag of the specific result type. -- the expression might differ from the tag of the specific result type.
if Is_Tagged_Type (Utyp) if Is_Tagged_Type (Utyp)
and then not Is_Class_Wide_Type (Utyp) and then not Is_Class_Wide_Type (Utyp)
...@@ -6616,8 +6610,8 @@ package body Exp_Ch6 is ...@@ -6616,8 +6610,8 @@ package body Exp_Ch6 is
or else (Is_Entity_Name (Exp) or else (Is_Entity_Name (Exp)
and then Ekind (Entity (Exp)) in Formal_Kind)) and then Ekind (Entity (Exp)) in Formal_Kind))
then then
-- When the return type is limited, perform a check that the -- When the return type is limited, perform a check that the tag of
-- tag of the result is the same as the tag of the return type. -- the result is the same as the tag of the return type.
if Is_Limited_Type (R_Type) then if Is_Limited_Type (R_Type) then
Insert_Action (Exp, Insert_Action (Exp,
...@@ -6637,8 +6631,8 @@ package body Exp_Ch6 is ...@@ -6637,8 +6631,8 @@ package body Exp_Ch6 is
-- If the result type is a specific nonlimited tagged type, then we -- If the result type is a specific nonlimited tagged type, then we
-- have to ensure that the tag of the result is that of the result -- have to ensure that the tag of the result is that of the result
-- type. This is handled by making a copy of the expression in the -- type. This is handled by making a copy of the expression in
-- case where it might have a different tag, namely when the -- the case where it might have a different tag, namely when the
-- expression is a conversion or a formal parameter. We create a new -- expression is a conversion or a formal parameter. We create a new
-- object of the result type and initialize it from the expression, -- object of the result type and initialize it from the expression,
-- which will implicitly force the tag to be set appropriately. -- which will implicitly force the tag to be set appropriately.
...@@ -6838,9 +6832,9 @@ package body Exp_Ch6 is ...@@ -6838,9 +6832,9 @@ package body Exp_Ch6 is
case Nkind (Discrim_Source) is case Nkind (Discrim_Source) is
when N_Defining_Identifier => when N_Defining_Identifier =>
pragma Assert (Is_Composite_Type (Discrim_Source) and then pragma Assert (Is_Composite_Type (Discrim_Source)
Has_Discriminants (Discrim_Source) and then and then Has_Discriminants (Discrim_Source)
Is_Constrained (Discrim_Source)); and then Is_Constrained (Discrim_Source));
declare declare
Discrim : Entity_Id := Discrim : Entity_Id :=
...@@ -6851,8 +6845,8 @@ package body Exp_Ch6 is ...@@ -6851,8 +6845,8 @@ package body Exp_Ch6 is
begin begin
loop loop
if Ekind (Etype (Discrim)) = if Ekind (Etype (Discrim)) =
E_Anonymous_Access_Type then E_Anonymous_Access_Type
then
Check_Against_Result_Level Check_Against_Result_Level
(Dynamic_Accessibility_Level (Node (Disc_Elmt))); (Dynamic_Accessibility_Level (Node (Disc_Elmt)));
end if; end if;
...@@ -6865,8 +6859,8 @@ package body Exp_Ch6 is ...@@ -6865,8 +6859,8 @@ package body Exp_Ch6 is
when N_Aggregate | N_Extension_Aggregate => when N_Aggregate | N_Extension_Aggregate =>
-- Unimplemented: extension aggregate case where -- Unimplemented: extension aggregate case where discrims
-- discrims come from ancestor part, not extension part. -- come from ancestor part, not extension part.
declare declare
Discrim : Entity_Id := Discrim : Entity_Id :=
...@@ -6894,18 +6888,19 @@ package body Exp_Ch6 is ...@@ -6894,18 +6888,19 @@ package body Exp_Ch6 is
(Comp_Id : Entity_Id; (Comp_Id : Entity_Id;
Associations : List_Id) return Node_Id Associations : List_Id) return Node_Id
is is
Assoc : Node_Id := First (Associations); Assoc : Node_Id;
Choice : Node_Id; Choice : Node_Id;
begin begin
-- Simple linear search seems ok here -- Simple linear search seems ok here
Assoc := First (Associations);
while Present (Assoc) loop while Present (Assoc) loop
Choice := First (Choices (Assoc)); Choice := First (Choices (Assoc));
while Present (Choice) loop while Present (Choice) loop
if (Nkind (Choice) = N_Identifier if (Nkind (Choice) = N_Identifier
and then Chars (Choice) = Chars (Comp_Id)) and then Chars (Choice) = Chars (Comp_Id))
or else (Nkind (Choice) = N_Others_Choice) or else (Nkind (Choice) = N_Others_Choice)
then then
return Expression (Assoc); return Expression (Assoc);
end if; end if;
...@@ -6928,13 +6923,15 @@ package body Exp_Ch6 is ...@@ -6928,13 +6923,15 @@ package body Exp_Ch6 is
loop loop
if Positionals_Exhausted then if Positionals_Exhausted then
Disc_Exp := Associated_Expr (Discrim, Disc_Exp :=
Component_Associations (Discrim_Source)); Associated_Expr
(Discrim,
Component_Associations (Discrim_Source));
end if; end if;
if Ekind (Etype (Discrim)) = if Ekind (Etype (Discrim)) =
E_Anonymous_Access_Type then E_Anonymous_Access_Type
then
Check_Against_Result_Level Check_Against_Result_Level
(Dynamic_Accessibility_Level (Disc_Exp)); (Dynamic_Accessibility_Level (Disc_Exp));
end if; end if;
...@@ -6950,15 +6947,18 @@ package body Exp_Ch6 is ...@@ -6950,15 +6947,18 @@ package body Exp_Ch6 is
end; end;
when N_Function_Call => when N_Function_Call =>
-- No check needed; check performed by callee.
-- No check needed (check performed by callee)
null; null;
when others => when others =>
declare declare
Level : constant Node_Id := Level : constant Node_Id :=
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Object_Access_Level (Discrim_Source)); Object_Access_Level (Discrim_Source));
begin begin
-- Unimplemented: check for name prefix that includes -- Unimplemented: check for name prefix that includes
-- a dereference of an access value with a dynamic -- a dereference of an access value with a dynamic
...@@ -6966,6 +6966,7 @@ package body Exp_Ch6 is ...@@ -6966,6 +6966,7 @@ package body Exp_Ch6 is
-- saooaaat) and use dynamic level in that case. For -- saooaaat) and use dynamic level in that case. For
-- example: -- example:
-- return Access_Param.all(Some_Index).Some_Component; -- return Access_Param.all(Some_Index).Some_Component;
-- ???
Set_Etype (Level, Standard_Natural); Set_Etype (Level, Standard_Natural);
Check_Against_Result_Level (Level); Check_Against_Result_Level (Level);
...@@ -7278,9 +7279,9 @@ package body Exp_Ch6 is ...@@ -7278,9 +7279,9 @@ package body Exp_Ch6 is
Thunk_Code, Thunk_Code,
Build_Set_Predefined_Prim_Op_Address (Loc, Build_Set_Predefined_Prim_Op_Address (Loc,
Tag_Node => Tag_Node =>
New_Reference_To (Node (Next_Elmt (Iface_DT_Ptr)), Loc), New_Reference_To (Node (Next_Elmt (Iface_DT_Ptr)), Loc),
Position => DT_Position (Prim), Position => DT_Position (Prim),
Address_Node => Address_Node =>
Unchecked_Convert_To (RTE (RE_Prim_Ptr), Unchecked_Convert_To (RTE (RE_Prim_Ptr),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -7288,11 +7289,11 @@ package body Exp_Ch6 is ...@@ -7288,11 +7289,11 @@ package body Exp_Ch6 is
Attribute_Name => Name_Unrestricted_Access))), Attribute_Name => Name_Unrestricted_Access))),
Build_Set_Predefined_Prim_Op_Address (Loc, Build_Set_Predefined_Prim_Op_Address (Loc,
Tag_Node => Tag_Node =>
New_Reference_To New_Reference_To
(Node (Next_Elmt (Next_Elmt (Next_Elmt (Iface_DT_Ptr)))), (Node (Next_Elmt (Next_Elmt (Next_Elmt (Iface_DT_Ptr)))),
Loc), Loc),
Position => DT_Position (Prim), Position => DT_Position (Prim),
Address_Node => Address_Node =>
Unchecked_Convert_To (RTE (RE_Prim_Ptr), Unchecked_Convert_To (RTE (RE_Prim_Ptr),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -7305,13 +7306,12 @@ package body Exp_Ch6 is ...@@ -7305,13 +7306,12 @@ package body Exp_Ch6 is
Next_Elmt (Iface_DT_Ptr); Next_Elmt (Iface_DT_Ptr);
pragma Assert (Has_Thunks (Node (Iface_DT_Ptr))); pragma Assert (Has_Thunks (Node (Iface_DT_Ptr)));
-- Skip the tag of the no-thunks dispatch table -- Skip tag of the no-thunks dispatch table
Next_Elmt (Iface_DT_Ptr); Next_Elmt (Iface_DT_Ptr);
pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr))); pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr)));
-- Skip the tag of the predefined primitives no-thunks dispatch -- Skip tag of predefined primitives no-thunks dispatch table
-- table.
Next_Elmt (Iface_DT_Ptr); Next_Elmt (Iface_DT_Ptr);
pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr))); pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr)));
...@@ -7363,8 +7363,8 @@ package body Exp_Ch6 is ...@@ -7363,8 +7363,8 @@ package body Exp_Ch6 is
-- slots. -- slots.
elsif Is_Imported (Subp) elsif Is_Imported (Subp)
and then (Convention (Subp) = Convention_CPP and then (Convention (Subp) = Convention_CPP
or else Convention (Subp) = Convention_C) or else Convention (Subp) = Convention_C)
then then
null; null;
...@@ -8276,7 +8276,6 @@ package body Exp_Ch6 is ...@@ -8276,7 +8276,6 @@ package body Exp_Ch6 is
is is
pragma Assert (Is_Build_In_Place_Function (Func_Id)); pragma Assert (Is_Build_In_Place_Function (Func_Id));
Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin begin
return return
not Restriction_Active (No_Finalization) not Restriction_Active (No_Finalization)
...@@ -8379,7 +8378,7 @@ package body Exp_Ch6 is ...@@ -8379,7 +8378,7 @@ package body Exp_Ch6 is
-- Unimplemented: a cross-dialect subp renaming which does not set -- Unimplemented: a cross-dialect subp renaming which does not set
-- the Alias attribute (e.g., a rename of a dereference of an access -- the Alias attribute (e.g., a rename of a dereference of an access
-- to subprogram value). -- to subprogram value). ???
return Present (Extra_Accessibility_Of_Result (Alias (Func_Id))); return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
......
gcc/ada/s-linux-alpha.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2009-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/s-oscons-tmplt.c
...@@ -1358,7 +1358,7 @@ CND(WSAEDISCON, "Disconnected") ...@@ -1358,7 +1358,7 @@ CND(WSAEDISCON, "Disconnected")
#if defined (__APPLE__) || defined (__linux__) || defined (DUMMY) #if defined (__APPLE__) || defined (__linux__) || defined (DUMMY)
/* /*
-- Sizes of pthread data types -- Sizes of pthread data types (on Darwin these are padding)
*/ */
#if defined (__APPLE__) || defined (DUMMY) #if defined (__APPLE__) || defined (DUMMY)
...@@ -1372,34 +1372,34 @@ CND(WSAEDISCON, "Disconnected") ...@@ -1372,34 +1372,34 @@ CND(WSAEDISCON, "Disconnected")
#define PTHREAD_RWLOCK_SIZE __PTHREAD_RWLOCK_SIZE__ #define PTHREAD_RWLOCK_SIZE __PTHREAD_RWLOCK_SIZE__
#define PTHREAD_ONCE_SIZE __PTHREAD_ONCE_SIZE__ #define PTHREAD_ONCE_SIZE __PTHREAD_ONCE_SIZE__
#else #else
#define PTHREAD_SIZE (sizeof (pthread_t)) #define PTHREAD_SIZE (sizeof (pthread_t))
#define PTHREAD_ATTR_SIZE __SIZEOF_PTHREAD_ATTR_T #define PTHREAD_ATTR_SIZE (sizeof (pthread_attr_t))
#define PTHREAD_MUTEXATTR_SIZE __SIZEOF_PTHREAD_MUTEXATTR_T #define PTHREAD_MUTEXATTR_SIZE (sizeof (pthread_mutexattr_t))
#define PTHREAD_MUTEX_SIZE __SIZEOF_PTHREAD_MUTEX_T #define PTHREAD_MUTEX_SIZE (sizeof (pthread_mutex_t))
#define PTHREAD_CONDATTR_SIZE __SIZEOF_PTHREAD_CONDATTR_T #define PTHREAD_CONDATTR_SIZE (sizeof (pthread_condattr_t))
#define PTHREAD_COND_SIZE __SIZEOF_PTHREAD_COND_T #define PTHREAD_COND_SIZE (sizeof (pthread_cond_t))
#define PTHREAD_RWLOCKATTR_SIZE __SIZEOF_PTHREAD_RWLOCKATTR_T #define PTHREAD_RWLOCKATTR_SIZE (sizeof (pthread_rwlockattr_t))
#define PTHREAD_RWLOCK_SIZE __SIZEOF_PTHREAD_RWLOCK_T #define PTHREAD_RWLOCK_SIZE (sizeof (pthread_rwlock_t))
#define PTHREAD_ONCE_SIZE (sizeof (pthread_once_t)) #define PTHREAD_ONCE_SIZE (sizeof (pthread_once_t))
#endif #endif
CND(PTHREAD_SIZE, "Pad in pthread_t") CND(PTHREAD_SIZE, "pthread_t")
CND(PTHREAD_ATTR_SIZE, "Pad in pthread_attr_t") CND(PTHREAD_ATTR_SIZE, "pthread_attr_t")
CND(PTHREAD_MUTEXATTR_SIZE, "Pad in pthread_mutexattr_t") CND(PTHREAD_MUTEXATTR_SIZE, "pthread_mutexattr_t")
CND(PTHREAD_MUTEX_SIZE, "Pad in pthread_mutex_t") CND(PTHREAD_MUTEX_SIZE, "pthread_mutex_t")
CND(PTHREAD_CONDATTR_SIZE, "Pad in pthread_condattr_t") CND(PTHREAD_CONDATTR_SIZE, "pthread_condattr_t")
CND(PTHREAD_COND_SIZE, "Pad in pthread_cond_t") CND(PTHREAD_COND_SIZE, "pthread_cond_t")
CND(PTHREAD_RWLOCKATTR_SIZE, "Pad in pthread_rwlockattr_t") CND(PTHREAD_RWLOCKATTR_SIZE, "pthread_rwlockattr_t")
CND(PTHREAD_RWLOCK_SIZE, "Pad in pthread_rwlock_t") CND(PTHREAD_RWLOCK_SIZE, "pthread_rwlock_t")
CND(PTHREAD_ONCE_SIZE, "Pad in pthread_once_t") CND(PTHREAD_ONCE_SIZE, "pthread_once_t")
#endif #endif
......
gcc/ada/s-osinte-linux.ads
...@@ -559,7 +559,7 @@ private ...@@ -559,7 +559,7 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type unsigned_long_long_t is mod 2 ** 64; type unsigned_long_long_t is mod 2 ** 64;
-- Local type only used to get it's 'Alignment below -- Local type only used to get the alignment of this type below
type pthread_attr_t is type pthread_attr_t is
array (1 .. OS_Constants.PTHREAD_ATTR_SIZE) of unsigned_char; array (1 .. OS_Constants.PTHREAD_ATTR_SIZE) of unsigned_char;
......
gcc/ada/s-solita.adb
...@@ -150,9 +150,10 @@ package body System.Soft_Links.Tasking is ...@@ -150,9 +150,10 @@ package body System.Soft_Links.Tasking is
EO : Ada.Exceptions.Exception_Occurrence; EO : Ada.Exceptions.Exception_Occurrence;
begin begin
-- We can only be here because we are terminating the environment task. -- We can only be here because we are terminating the environment
-- Task termination for the rest of the tasks is handled in the -- task. Task termination for the rest of the tasks is handled in
-- Task_Wrapper. -- the Task_Wrapper.
-- We do not want to enable this check and e.g. call System.OS_Lib.Abort -- We do not want to enable this check and e.g. call System.OS_Lib.Abort
-- here because some restricted run-times may not have system.os_lib -- here because some restricted run-times may not have system.os_lib
-- (e.g. JVM), and calling abort may do more harm than good to the -- (e.g. JVM), and calling abort may do more harm than good to the
...@@ -179,9 +180,9 @@ package body System.Soft_Links.Tasking is ...@@ -179,9 +180,9 @@ package body System.Soft_Links.Tasking is
Ada.Exceptions.Save_Occurrence (EO, Excep); Ada.Exceptions.Save_Occurrence (EO, Excep);
end if; end if;
-- There is no need for explicit protection against race conditions -- There is no need for explicit protection against race conditions for
-- for this part because it can only be executed by the environment -- this part because it can only be executed by the environment task
-- task after all the other tasks have been finalized. -- after all the other tasks have been finalized.
if Self_Id.Common.Specific_Handler /= null then if Self_Id.Common.Specific_Handler /= null then
Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO); Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
......
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