OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
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> 2011-09-05 Thomas Quinot <quinot@adacore.com>
* exp_intr.adb, s-tasini.adb: Minor reformatting. * exp_intr.adb, s-tasini.adb: Minor reformatting.

56
gcc/ada/s-tassta.adb
View File

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

6
gcc/ada/sem_ch6.adb
View File

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