[multiple changes]

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

	* sem_ch6.adb: Minor reformatting.

2011-09-05  Matthew Gingell  <gingell@adacore.com>

	* s-tassta.adb (Task_Wrapper): Ensure that we don't try to write the
	stack guard page on PPC Linux. This patch ensures the 64K guard page at
	the bottom of the stack is not overwritten.

From-SVN: r178544
This commit is contained in:
Arnaud Charlet 2011-09-05 16:00:30 +02:00
parent 13a0b1e8dd
commit 81bf23820f
3 changed files with 44 additions and 28 deletions

View File

@ -1,3 +1,13 @@
2011-09-05 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb: Minor reformatting.
2011-09-05 Matthew Gingell <gingell@adacore.com>
* s-tassta.adb (Task_Wrapper): Ensure that we don't try to write the
stack guard page on PPC Linux. This patch ensures the 64K guard page at
the bottom of the stack is not overwritten.
2011-09-05 Thomas Quinot <quinot@adacore.com>
* exp_intr.adb, s-tasini.adb: Minor reformatting.

View File

@ -529,12 +529,15 @@ package body System.Tasking.Stages is
if CPU /= Unspecified_CPU
and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
or else CPU > Integer (System.Multiprocessors.CPU_Range'Last)
or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
or else
CPU > Integer (System.Multiprocessors.CPU_Range'Last)
or else
CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
then
raise Tasking_Error with "CPU not in range";
-- Normal CPU affinity
else
Base_CPU :=
(if CPU = Unspecified_CPU
@ -1001,8 +1004,8 @@ package body System.Tasking.Stages is
Initialization.Defer_Abort (Self_ID);
-- Loop through the From chain, changing their Master_of_Task
-- fields, and to find the end of the chain.
-- Loop through the From chain, changing their Master_of_Task fields,
-- and to find the end of the chain.
loop
C.Master_of_Task := New_Master;
@ -1088,10 +1091,10 @@ package body System.Tasking.Stages is
-- Indicates the reason why this task terminates. Normal corresponds to
-- a task terminating due to completing the last statement of its body,
-- or as a result of waiting on a terminate alternative. If the task
-- terminates because it is being aborted then Cause will be set to
-- Abnormal. If the task terminates because of an exception raised by
-- the execution of its task body, then Cause is set to
-- Unhandled_Exception.
-- terminates because it is being aborted then Cause will be set
-- to Abnormal. If the task terminates because of an exception
-- raised by the execution of its task body, then Cause is set
-- to Unhandled_Exception.
EO : Exception_Occurrence;
-- If the task terminates because of an exception raised by the
@ -1172,14 +1175,16 @@ package body System.Tasking.Stages is
-- smaller values resulted in segmentation faults from dynamic
-- stack analysis.
Big_Overflow_Guard : constant := 16 * 1024;
Big_Overflow_Guard : constant := 64 * 1024 + 8 * 1024;
Small_Stack_Limit : constant := 64 * 1024;
-- ??? These three values are experimental, and seem to work on
-- most platforms. They still need to be analyzed further. They
-- also need documentation, what are they???
-- also need documentation, what are they and why does the logic
-- differ depending on whether the stack is large or small???
Pattern_Size : Natural :=
Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
Natural (Self_ID.Common.
Compiler_Data.Pri_Stack_Info.Size);
-- Size of the pattern
Stack_Base : Address;
@ -1187,6 +1192,7 @@ package body System.Tasking.Stages is
begin
Stack_Base := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base;
if Stack_Base = Null_Address then
-- On many platforms, we don't know the real stack base
@ -1211,6 +1217,7 @@ package body System.Tasking.Stages is
else Big_Overflow_Guard);
else
-- Reduce by the size of the final guard page
Pattern_Size := Pattern_Size - Guard_Page_Size;
end if;
@ -1256,8 +1263,7 @@ package body System.Tasking.Stages is
end if;
if Global_Task_Debug_Event_Set then
Debug.Signal_Debug_Event
(Debug.Debug_Event_Run, Self_ID);
Debug.Signal_Debug_Event (Debug.Debug_Event_Run, Self_ID);
end if;
begin
@ -1311,6 +1317,7 @@ package body System.Tasking.Stages is
(Debug.Debug_Event_Abort_Terminated, Self_ID);
end if;
end if;
when others =>
-- ??? Using an E : others here causes CD2C11A to fail on Tru64
@ -1395,10 +1402,9 @@ package body System.Tasking.Stages is
-- Terminate_Task --
--------------------
-- Before we allow the thread to exit, we must clean up. This is a
-- delicate job. We must wake up the task's master, who may immediately try
-- to deallocate the ATCB out from under the current task WHILE IT IS STILL
-- EXECUTING.
-- Before we allow the thread to exit, we must clean up. This is a delicate
-- job. We must wake up the task's master, who may immediately try to
-- deallocate the ATCB from the current task WHILE IT IS STILL EXECUTING.
-- To avoid this, the parent task must be blocked up to the latest
-- statement executed. The trouble is that we have another step that we
@ -1433,8 +1439,7 @@ package body System.Tasking.Stages is
-- Since GCC cannot allocate stack chunks efficiently without reordering
-- some of the allocations, we have to handle this unexpected situation
-- here. We should normally never have to call Vulnerable_Complete_Task
-- here.
-- here. Normally we never have to call Vulnerable_Complete_Task here.
if Self_ID.Common.Activator /= null then
Vulnerable_Complete_Task (Self_ID);
@ -1455,6 +1460,7 @@ package body System.Tasking.Stages is
if Single_Lock then
Utilities.Independent_Task_Count :=
Utilities.Independent_Task_Count - 1;
else
Write_Lock (Environment_Task);
Utilities.Independent_Task_Count :=
@ -1581,8 +1587,8 @@ package body System.Tasking.Stages is
pragma Assert (Self_ID.Common.Activator /= null);
-- Remove dangling reference to Activator, since a task may
-- outlive its activator.
-- Remove dangling reference to Activator, since a task may outlive its
-- activator.
Self_ID.Common.Activator := null;
@ -1713,12 +1719,13 @@ package body System.Tasking.Stages is
if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
pragma Assert (C.Common.State = Unactivated);
-- Usually, C.Common.Activator = Self_ID implies C.Master_of_Task
-- = CM. The only case where C is pending activation by this
-- task, but the master of C is not CM is in Ada 2005, when C is
-- part of a return object of a build-in-place function.
pragma Assert (C.Common.State = Unactivated);
Write_Lock (C);
C.Common.Activator := null;
C.Common.State := Terminated;
@ -1933,9 +1940,8 @@ package body System.Tasking.Stages is
declare
Detach_Interrupt_Entries_Index : constant Task_Entry_Index := 1;
-- Corresponds to the entry index of System.Interrupts.
-- Interrupt_Manager.Detach_Interrupt_Entries.
-- Be sure to update this value when changing
-- Interrupt_Manager specs.
-- Interrupt_Manager.Detach_Interrupt_Entries. Be sure
-- to update this value when changing Interrupt_Manager specs.
type Param_Type is access all Task_Id;

View File

@ -2712,9 +2712,9 @@ package body Sem_Ch6 is
-- for discriminals and privals and finally a declaration for the entry
-- family index (if applicable). This form of early expansion is done
-- when the Expander is active because Install_Private_Data_Declarations
-- references entities which were created during regular expansion.
-- The body may be the rewritting of an expression function, and we need
-- to verify that the original node is in the source.
-- references entities which were created during regular expansion. The
-- body may be the rewritting of an expression function, and we need to
-- verify that the original node is in the source.
if Full_Expander_Active
and then Comes_From_Source (Original_Node (N))