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