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

s-taprop-linux.adb (Get_Stack_Attributes): New subprogram. 

2007-08-14  Olivier Hainque  <hainque@adacore.com>

	* s-taprop-linux.adb (Get_Stack_Attributes): New subprogram. Fetch the
	stack size and initial stack pointer value for a given task.
	(Enter_Task): Get the stack attributes of the task we are entering and
	let the stack checking engine know about them.

	* s-stchop.adb, s-stchop.ads (Notify_Stack_Attributes): New subprogram.
	Let the stack-checking engine know about the initial sp value and stack
	size associated with the current task.
	(Set_Stack_Info): If a stack base has been notified for the current
	task, honor it. Fallback to the previous less accurate method otherwise.

	* s-stchop-vxworks.adb (Notify_Stack_Attributes): Dummy body.

From-SVN: r127435
This commit is contained in:
Olivier Hainque 2007-08-14 10:44:14 +02:00 committed by Arnaud Charlet
parent a2264f2d54
commit febb581c99
4 changed files with 146 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/s-stchop-vxworks.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, 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- --
@ -95,6 +95,24 @@ package body System.Stack_Checking.Operations is
Cache := Null_Stack;
end Invalidate_Stack_Cache;
-----------------------------
-- Notify_Stack_Attributes --
-----------------------------
procedure Notify_Stack_Attributes
(Initial_SP : System.Address;
Size : System.Storage_Elements.Storage_Offset)
is
-- We retrieve the attributes directly from Set_Stack_Info below, so
-- this implementation has nothing to do.
pragma Unreferenced (Initial_SP);
pragma Unreferenced (Size);
begin
null;
end Notify_Stack_Attributes;
--------------------
-- Set_Stack_Info --
--------------------
@ -120,7 +138,7 @@ package body System.Stack_Checking.Operations is
Task_Info : aliased OS_Stack_Info;
begin
-- The order of steps 1 .. 3 is important, see specification.
-- The order of steps 1 .. 3 is important, see specification
-- 1) Get the Stack_Access value for the current task

33
gcc/ada/s-stchop.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, 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- --
@ -86,6 +86,26 @@ package body System.Stack_Checking.Operations is
Cache := Null_Stack;
end Invalidate_Stack_Cache;
-----------------------------
-- Notify_Stack_Attributes --
-----------------------------
procedure Notify_Stack_Attributes
(Initial_SP : System.Address;
Size : System.Storage_Elements.Storage_Offset)
is
My_Stack : constant Stack_Access := Soft_Links.Get_Stack_Info.all;
-- We piggyback on the 'Limit' field to store what will be used as the
-- 'Base' and leave the 'Size' alone to not interfere with the logic in
-- Set_Stack_Info below.
pragma Unreferenced (Size);
begin
My_Stack.Limit := Initial_SP;
end Notify_Stack_Attributes;
--------------------
-- Set_Stack_Info --
--------------------
@ -102,7 +122,7 @@ package body System.Stack_Checking.Operations is
Limit : Integer;
begin
-- The order of steps 1 .. 3 is important, see specification.
-- The order of steps 1 .. 3 is important, see specification
-- 1) Get the Stack_Access value for the current task
@ -131,7 +151,14 @@ package body System.Stack_Checking.Operations is
end if;
end if;
My_Stack.Base := Frame_Address;
-- If a stack base address has been registered, honor it.
-- Fallback to the address of a local object otherwise.
if My_Stack.Limit /= System.Null_Address then
My_Stack.Base := My_Stack.Limit;
else
My_Stack.Base := Frame_Address;
end if;
if Stack_Grows_Down then

12
gcc/ada/s-stchop.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, 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- --
@ -42,6 +42,8 @@ pragma Polling (Off);
-- Turn off polling, we do not want polling to take place during stack
-- checking operations. It causes infinite loops and other problems.
with System.Storage_Elements;
package System.Stack_Checking.Operations is
pragma Preelaborate;
@ -59,6 +61,14 @@ package System.Stack_Checking.Operations is
function Stack_Check (Stack_Address : System.Address) return Stack_Access;
-- This version of Stack_Check should not be inlined
procedure Notify_Stack_Attributes
(Initial_SP : System.Address;
Size : System.Storage_Elements.Storage_Offset);
-- Register Initial_SP as the initial stack pointer value for the current
-- task when it starts and Size as the associated stack area size. This
-- should be called once, after the soft-links have been initialized and
-- prior to the first "Stack_Check" call.
private
Cache : aliased Stack_Access := Null_Stack;

86
gcc/ada/s-taprop-linux.adb
View File

@ -63,8 +63,9 @@ with System.Soft_Links;
-- For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
with System.Storage_Elements;
with System.Stack_Checking.Operations;
-- Used for Invalidate_Stack_Cache;
-- Used for Invalidate_Stack_Cache and Notify_Stack_Attributes;
with Ada.Exceptions;
-- used for Raise_Exception
@ -85,6 +86,7 @@ package body System.Task_Primitives.Operations is
use System.OS_Interface;
use System.Parameters;
use System.OS_Primitives;
use System.Storage_Elements;
----------------
-- Local Data --
@ -175,6 +177,13 @@ package body System.Task_Primitives.Operations is
function To_pthread_t is new Ada.Unchecked_Conversion
(unsigned_long, System.OS_Interface.pthread_t);
procedure Get_Stack_Attributes
(T : Task_Id;
ISP : out System.Address;
Size : out Storage_Offset);
-- Fill ISP and Size with the Initial Stack Pointer value and the
-- thread stack size for task T.
-------------------
-- Abort_Handler --
-------------------
@ -705,6 +714,50 @@ package body System.Task_Primitives.Operations is
return T.Common.Current_Priority;
end Get_Priority;
--------------------------
-- Get_Stack_Attributes --
--------------------------
procedure Get_Stack_Attributes
(T : Task_Id;
ISP : out System.Address;
Size : out Storage_Offset)
is
function pthread_getattr_np
(thread : pthread_t;
attr : System.Address) return Interfaces.C.int;
pragma Import (C, pthread_getattr_np, "pthread_getattr_np");
function pthread_attr_getstack
(attr : System.Address;
base : System.Address;
size : System.Address) return Interfaces.C.int;
pragma Import (C, pthread_attr_getstack, "pthread_attr_getstack");
Result : Interfaces.C.int;
Attributes : aliased pthread_attr_t;
Stack_Base : aliased System.Address;
Stack_Size : aliased Storage_Offset;
begin
Result :=
pthread_getattr_np
(T.Common.LL.Thread, Attributes'Address);
pragma Assert (Result = 0);
Result :=
pthread_attr_getstack
(Attributes'Address, Stack_Base'Address, Stack_Size'Address);
pragma Assert (Result = 0);
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
ISP := Stack_Base + Stack_Size;
Size := Stack_Size;
end Get_Stack_Attributes;
----------------
-- Enter_Task --
----------------
@ -726,6 +779,18 @@ package body System.Task_Primitives.Operations is
end loop;
Unlock_RTS;
-- Determine where the task stack starts, how large it is, and let the
-- stack checking engine know about it.
declare
Initial_SP : System.Address;
Stack_Size : Storage_Offset;
begin
Get_Stack_Attributes (Self_ID, Initial_SP, Stack_Size);
System.Stack_Checking.Operations.Notify_Stack_Attributes
(Initial_SP, Stack_Size);
end;
end Enter_Task;
--------------
@ -1141,6 +1206,25 @@ package body System.Task_Primitives.Operations is
end if;
end Resume_Task;
--------------------
-- Stop_All_Tasks --
--------------------
procedure Stop_All_Tasks is
begin
null;
end Stop_All_Tasks;
-------------------
-- Continue_Task --
-------------------
function Continue_Task (T : ST.Task_Id) return Boolean is
pragma Unreferenced (T);
begin
return False;
end Continue_Task;
----------------
-- Initialize --
----------------